

m.                monitor text 7

; main entry for sub proc:
;
b.j1                      ; begin
w.h32:                    ; main entry for sub proc:
      rl  w0  x3+a50      ;
      sn  w0  0           ;   if main proc(sub proc) = 0 then
      jl      g4          ;     goto result 4;
      rl  w0 (0)          ;
      sn  w0  72          ;   if kind(main proc) = 72 then
      jl.    (j0.)        ;     goto rbct sub proc entry;
      jl.    (j1.)        ;   goto scc sub proc entry;
  j0:         h36         ; rbct sub proc entry;
  j1:         h37         ; scc sub proc entry;
e.                        ; end of main entry for sub proc;
; scc-driver.
; this block includes a number of drivers that are used for communication
; with devices in the rc-net.

c.(:a81>10a.1:)-1

m.          scc main

; block including main-, host- and sub-process drivers.

b.f20,p340,v120 w.

; block including main-process driver.

b.e10,m10,n20,q20,r20,s10,t20 w.

; the following define global formats and constants

v0   =     8               ; highest number of buffers at the same time transmitted to a device
v1   =     12              ; number of bytes in private part of subproc description
v2   =     1<12-1          ; maximum buffer size for datanet
v3   =     16              ; max number of operations at the same time transmitted from a hostproc

; function codes for hostproc
                    
;v-name supv.code code  mess/answ no data/data   dec.value name
      
v31=     0<7    + 0<2 + 0<1     +  0          ;  0        message create
v32=     0<7    + 0<2 + 1<1     +  0          ;  2        answer create
v37=     0<7    + 1<2 + 0<1     +  0          ;  4        message remove
v38=     0<7    + 1<2 + 1<1     +  0          ;  6        answer remove
v35=     0<7    + 2<2 + 0<1     +  0          ;  8        message release
v36=     0<7    + 2<2 + 1<1     +  0          ; 10        answer release
     
v33=     0<7    + 3<2 + 0<1     +         1   ; 13        message lookup
v34=     0<7    + 3<2 + 1<1     +  0  ;   1   ; 14/15     answer lookup
v10=     0<7    + 4<2 + 0<1     +         1   ; 17        message lookup reserve
v11=     0<7    + 4<2 + 1<1     +  0  ;   1   ; 18/19     answer lookup reserve
v12=     0<7    + 5<2 + 0<1     +         1   ; 21        message lookup release
v13=     0<7    + 5<2 + 1<1     +  0          ; 22        answer lookup release
v14=     0<7    + 6<2 + 0<1     +         1   ; 25        message lookup link remote
v15=     0<7    + 6<2 + 1<1     +  0  ;   1   ; 26/27     answer lookup link remote
v16=     0<7    + 7<2 + 0<1     +         1   ; 29        message lookup link local
v17=     0<7    + 7<2 + 1<1     +  0  ;   1   ; 30/31     answer lookup link local
          
v22=     0<7    +10<2 + 0<1     +  0          ; 40        message operator input
v23=     0<7    +10<2 + 1<1     +  0  ;   1   ; 42/43     answer operator input
v24=     0<7    +11<2 + 0<1     +  0  ;   1   ; 44/45     message operator output
v25=     0<7    +11<2 + 1<1     +  0          ; 46        answer operator output
        
; smallest function value for the subprocesses
     
v40=     1<7    + 0<2 + 0<1     +  0          ; 128       min subproc function value
            
; function codes for subprocesses
         
v50=     1<7    + 3<2 + 0<1     +  0          ; 140       message input
v51=     1<7    + 3<2 + 1<1     +  0  ;   1   ; 142/143   answer input
v52=     1<7    + 4<2 + 0<1     +  0  ;   1   ; 144/145   message output
v53=     1<7    + 4<2 + 1<1     +  0          ; 146       answer output
v54=     1<7    + 5<2 + 0<1     +         1   ; 149       message control
v55=     1<7    + 5<2 + 1<1     +  0  ;   1   ; 150/151   answer control
v56=     1<7    + 6<2 + 0<1     +  0  ;   1   ; 152/153   message user name
v57=     1<7    + 6<2 + 1<1     +  0          ; 154       answer user name
v58=     1<7    + 7<2 + 0<1     +  0          ; 156       message att
v59=     1<7    + 7<2 + 1<1     +  0          ; 158       answer att
          

; definition of bitpatterns in state-field of subprocs (p12)
v70  =     2.0001 <8       ; subproc blocked
v71  =     2.0010 <8       ; answer attention pending
v72  =     2.0100 <8       ; messages pending

; bit 0 - 7 are reserved for bufno (used in answer attention)

;*p1*


; process description of subprocess:
;
; monitor part:
; a48:                     ; <interval>
; a49:                     ; <interval>
; a10:                     ; <kind>
; a11:                     ; <name>
; a50:                     ; <mainproc>
; a52:                     ; <reserver>
; a53:                     ; <users>
; a54:                     ; <first message>
; a55:                     ; <last message>
; a56:                     ; <external state>

; specific part:
p0 =a70                    ; first(specific part)
p1 =p0+v1                  ; top(specific part)

; mainprocess part:
p11=p1     , p9 =p11+1     ; <devno>    , <rcno>
p10=p11+2  , p8 =p10+1     ; <subkind>  , <data quality>
p12=p10+2                  ; <state(sub)>
p14=p12+2                  ; <next subprocess>
p15=p14+2                  ; <last subprocess>
p16=p15+2  , p17=p16+1     ; <buffers free> , <current bufno>
p18=p16+2                  ; <max bufsize(in chars)>
p7 =p18+2  , p6= p7+1      ; <receiver net-id> , <receiver home reg>
p5 = p7+2                  ; <receiver host-id>
p13=p5 +2                  ; <current message>
p19=p13+2                  ; start(mess buf table):
a79=p19+v0<1               ; top(mess buf table)

c.(:a63-p10:)*(:a63-p10:)-1, m. name error a63
z.
c.(:a64-p12:)*(:a64-p12:)-1, m. name error a64
z.

;*p2*

; process description of mainprocess:
;
; monitor part:
; a48:                     ; <interval>
; a49:                     ; <interval>
; a10:                     ; <kind>
; a11:                     ; <name>
; a50:                     ; <device no(intexp)*64>
; a52:                     ; <reserver>
; a53:                     ; <users>
; a54:                     ; <first message>
; a55:                     ; <last message>
; a56:                     ; <interrupt response addr>

; p0                       ; start of spec part:
s0=p0                      ; <start(next record)>
s1=s0+2                    ; <top(test buffer)>
                           ; <mask0(0:23)>
s2=s1+4                    ; <mask0(24:47)>
                           ; <mask1(48:71)>
s3=s2+4                    ; <mask1(72:95)>
; p1=p11    , p9           ; <home reg> shift 16 + <host-id>
; p10       , p8           ; <first of corebuffer>
; p12                      ; <ret address after subproc call>
; p14                      ; <next subpresces>
; p15                      ; <last subprocess>
; p16                      ; <operation>

; line parameters:
p2=p16+2                   ; block out description:
 p20=0      , p21=p20+1    ;  <headchar out>  , <count out>
 p22=p20+2                 ;  <first out>
 p23=p22+2                 ;  <last out>
 p24=p23+2                 ;  <status out>
 p25=p24+2                 ;  <devno(trm)*64>
p3=p2+p25+2                ; block in description:
                           ;  <headchar in>   , <count in>
                           ;  <first in>
                           ;  <last in>
                           ;  <status in>
                           ;  <devno(rec)*64>
                           ;
p30=p3+p25+2               ; <request>
p31=p30+2                  ; <first waiting>
                           ; <time(0:23)>
p32=p31+4                  ; <time(24:47)>
p34=p32+2                  ; <max wait ready time(in 0.1 ms)>

; communication parameters:
p38=p34+2   , p39=p38+1    ;                  , <type>
p40=p38+2   , p41=p40+1    ; <expstate>       , <control>
p42=p40+2   , p43=p42+1    ; <acktr>          , <ackrec>
p44=p42+2   , p45=p44+1    ; <count0>         , <count1>
p46=p44+2   , p47=p46+1    ; <timer0>         , <timer1>

; communication areas:
p50=p46+2                  ; first(std out area)
p51=p50+16                 ; last(std out area)

p52=p51+2                  ; first(std in area)
p53=p52+16                 ; last(std in area)

; transmit parameters:
p60=p53+2   , p61=p60+1    ; <internal status>, <function>
p62=p60+2   , p74=p62+1    ; <state>    , <various>
p63=p62+2                  ; <mode>
p64=p63+2                  ; <size>
p65=p64+2                  ; <first data trm>
p66=p65+2                  ; <last data trm>
p67=p66+2   , p68=p67+1    ; <count data trm> , <bufno>
p69=p67+2   , p78=p69+1    ; <receiver linkno> , <sender linkno>
p71=p69+2   , p72=p71+1    ; <receiver net id> , <receiver home reg>
p73=p71+2                  ; <receiver host-id>
p79=p73+2                  ; <local function>  ,
p70=p79+2                  ; <proc desc(trm)>

; receive parameters:
p80=p70+2   , p81=p80+1    ; <internal status>, <function>
p82=p80+2   , p94=p82+1    ; <result>   , <various>
p83=p82+2                  ; <status>
p84=p83+2                  ; <size>
p85=p84+2                  ; <first data rec>
p86=p85+2                  ; <last data rec>
p87=p86+2   , p88=p87+1    ; <count data rec> , <bufno>
p89=p87+2   , p98=p89+1    ; <receiver linkno> , <sender linkno>
p91=p89+2   , p92=p91+1    ; <sender net-id>   , <sender home reg>
p93=p91+2                  ; <sender host-id>
p99=p93+2                  ; <local function>  ,
p90=p99+2                  ; <proc desc(rec)>

p95=p90+2                  ; counter for test record
p96=p95+2                  ; after m. clear oper in n7, sensed count
p97=p96+2                  ; sensed core store address

p100=p97+2                 ; top of process description
         
p201=0                     ; statistic switch on: 0; off: -1;
     
c.p201                     ; ***statistic***
    
; statistic information about line performance
   
p244= p97+2                ; no of master clears received
p245=p244+2                ; no of master clears send
p204=p245+2                ; no of clear timer
p205=p204+2                ; no of restart0
p206=p205+2                ; no of restart1
p207=p206+2                ; no of retransmit0
p208=p207+2                ; no of retransmit1
p209=p208+2                ; no of enquiry send
p210=p209+2                ; no of nak send
p211=p210+2                ; no of headers send
p212=p211+2                ; no of ack send
p213=p212+2                ; no of datablocks send
p214=p213+2                ; no of request for line send
p215=p214+2                ; no of general poll received
p235=p215+2                ; curr t.entry value (0-12)
                           ;
p236=p235+4                ; total time
                           ;
p237=p236+4                ; t_code_time
                           ;
p238=p237+4                ; q_code_time
                           ;
p239=p238+4                ; m_code_time
                           ;
p216=p239+4                ; wait1 time
                           ;
p217=p216+4                ; wait2 time
                           ;
p218=p217+4                ; wait3 time
                           ;
p219=p218+4                ; wait4 time
                           ;
p240=p219+4                ; wait1_before_request
                           ;
p241=p240+4                ; wait2_before_request
                           ;
p220=p241+4                ; m-call time
                           ;
p221=p220+4                ; q-call time
                           ;
p242=p221+4                ; req_call_time
                           ;
p222=p242+4                ; t0-entry time
                           ;
p223=p222+4                ; t1-entry time
                           ;
p224=p223+4                ; t2-entry time
                           ; 
p225=p224+4                ; t3-entry time
                           ;
p226=p225+4                ; t4-entry time
                           ;
p227=p226+4                ; t5-entry time
                           ;
p228=p227+4                ; t6-entry time
                           ;
p229=p228+4                ; t7-entry time
                           ;
p230=p229+4                ; t8-entry time
                           ;
p231=p230+4                ; t9-entry time
                           ;
p232=p231+4                ; t10-entry time
                           ;
p233=p232+4                ; t11-entry time
                           ;
p234=p233+4                ; t12-entry time
                           ;
p243=p234+4                ; now time
     
p100=p243+2                ; redefinition of top of process description
    
z.                         ; ***statistic***
      
a65=p100

; the process description of the hostproc shall be placed right
; after the main proc desc.


; definition of internal constants.

p101=0          ; test switch, on: 0, off: -1
p103=0          ; rc4000: 0, rc8000: 1

p102=8.000      ; value of soh-headchar
p105=8.155      ; value of enq-headchar
p104=8.333      ; value of stx-headchar

p110=80         ; kind of mainproc
p111=82         ; kind of hostproc
p112=84         ; kind of local subproc
p113=85         ; kind of free or remote subproc

p120=2.0000     ; state:=ready
p121=2.0001     ; state:=waiting for buffers
p122=2.0010     ; state:=waiting

p130=2.000      ; type:=ack/header
p131=2.001      ; type:=poll
p133=2.010      ; type:=request for line
p134=2.100      ; type:=master clear
p135=2.110      ; type:=answer master clear

p144=3          ; maxcount0
p145=12         ; maxcount1
p146=3          ; maxtimer0
p147=20         ; maxtimer1

p160=0          ; internal status:=ok
p161=1          ; internal status:=wait
p162=2          ; internal status:=skip
p163=3          ; internal status:=reject
p164=-1         ; internal status:=regret

p202=p100-a48   ; hostproc relative to main

; format of header.

;  word0     00:15     size
;            16:21     dummy
;  word0,1   22:07     control
;  word1     08:08     retransmission / req for retransmission
;            09:15     local function
;            16:21     format(packet)
;            22:23     priority
;  word2     00:07     receiver net-id / sender net-id
;            08:15     receiver home-reg / sender home-reg
;  word2,3   16:07     receiver host-id / sender host-id
;  word3     08:23     packet id
;  word4     00:15     facility mask
;            16:18     dummy
;            19:23     dummy / packets in unit
;  word5     00:02     dummy
;            03:07     dummy / packetno in unit
;            08:13     format(message)
;            14:23     sender linkno
;  word6     00:05     data quality
;            06:15     receiver linkno
;  word6,7   16:07     size
;  word7     08:15     bufferno
;            16:23     function
;  word8     00:02     state / result
;            03:15     mode / status


; format of control field:
;           0:2   type
;           3:3   acknowledge on/off
;           4:4   positive ack
;           5:5   ackrec
;           6:7   blockcontrol
;           8:8   header
;           9:9   data follows

; request=  0   : standard value
;           1   : sending request for line
;           2   : after request for line, before next message

; count0 : number of concurrent enquiries
; count1 : number of concurrent transmission errors
; timer0 : number of timeouts since the block header+ack was transmitted
; timer1 : number of timeouts since last ack was transmitted

;*p3*

; log and test facility.

;  format of test record:
;   +0 :  type, length(record)
;   +2 :  time1
;   +4 :  time2
;   +6 :  test information
;   +8 :  ...
;   +10:  ...
;
;  the call of the test facility is performed like this:
; b.f1 w.              ;
;    rs. w3  f0.       ; save w3;
;    jl. w3  f4.       ; check condition(type,on/off);
;    <type>            ;  type of test point
; f0:<saved w3>        ;  saved w3
;                      ;  off: w0-w2: unchanged, w3: saved w3;
;    jl.     f1.       ;   goto end of test;
;    .....             ;  on:  w0-w2: unchanged, w3: start(internal test area);
;    .....             ;   pack testinformation;
;    al  w0  <first>   ;  first:=first(test area);
;    al  w1  <last>    ;  last:=last(test area);
;    jl. w3  f5.       ;  create test record;
; f1:                  ; end of test:
; e.                   ;

; mainprocess.
; the mainprocess accepts messages of the following types:
;   start              2<12
;   stop               4<12
;   reset              6<12
;   master clear       8<12
;   autoload           9<12
;   set mask          12<12
;
; mainprocess - test part.
b.i10,j10 w.

     a0=1<23           ;
     a0>2+a0>4+a0>6+a0>8    ;
i0:  a0

i1:  0                 ; copy(buffer)
     0                 ;
     0                 ;
     0                 ;

h33: bz  w0  x2+8      ; start:
     sn  w0  12        ;   if op=12 then
     jl.     j10.      ;     goto setmask;
     jl  w3  g14       ;   check user;
     dl. w1  i0.       ;
     jl  w3  g16       ;   check operation(0.2.3.4.5.6.10.12,0);
     rl  w1  b19       ;

; supervise.

     dl  w0  x2+10     ; supervise:
     ds. w0  i1.+2     ;
     dl  w0  x2+14     ;
     ds. w0  i1.+6     ;
     al  w0  0         ;   status:=0;
     rs  w0  g20       ;
     jl  w3  g18       ;   deliver result1;
     al. w2  i1.       ;   addr:=addr of copy(buffer);

; tecnical mode.
; w1: mainproc, w2: copy (buffer)
b.j10,i10 w.
c.p201                 ;*****statistics*****
     rs. w2  i0.       ; save w2
     jl. w3  n9.       ;
     ds  w3  x1+p232   ;
     al  w2  10        ;
     rs  w2  x1+p235   ; set t10 entry
     rl. w2  i0.       ; get saved w2
z.                     ; ***statistic***
     bl  w3  x2        ;
     rs  w3  x1+p16    ;   save operation;
c.p101  b.f1 w.
     rs. w3  f0.       ; start test 4
     jl. w3  f4.       ;
     4                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p16    ;
     al  w1  x1+p3+p25 ;
     jl. w3  f5.       ;
f1:                    ; end test 4
e.z.
     sz  w3  2.1       ;
     jl.     j0.       ;
     jl.    (x3+2)     ;   goto label(operation);
     j0                ;  0 :  sense
     j1                ;  2 :  start
     j2                ;  4 :  stop
     j3                ;  6 :  reset
     j4                ;  8 :  master clear

j0:  jl     (b20)      ; sense:   return to program;

j1:  jl. w3  n13.      ; start:
     al  w3  x1+p52    ;
     al  w0  x1+p53    ;
     ds  w0  x1+p3+p23 ;
     rl. w0  r3.       ;
     rs  w0  x1+p3+p20 ;
c.p201                 ; ***statistic***
     jl. w3  n9.
     ds  w3  x1+p220   ; set m-call time
     ds  w3  x1+p221   ; set q-call time
z.                     ; ***statistic***
     jl.     m6.       ;

j3:  jl. w3  n14.      ; reset: clear subprocesses;
j2:  jl. w3  n7.       ; stop: stop transmitter and receiver;
     jl. w3  m10.      ;    ex: goto exception;
     al  w0  0         ;
     hs  w0  x1+p40    ;   expstate:=0;
     al. w0  c56.      ;   interrupt address(main proc):=
                     ;(defined in the end of monitortext 6);
     rs  w0  x1+a56    ;     interrupt routine for scc401 tech;
     jl     (b20)      ;   goto return;

j4:  al  w0  0         ; master clear:
     hs  w0  x1+p40    ;   expstate:=0;
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p221   ; set g-call time

z.                     ; ***statistic***
     jl.     q0.       ;   send master clear;
c.p201
i0:  0                 ; save w2
z.
e.

j10: dl  w0  x2+12     ; set mask:
     rl  w1  b19       ;
     ds  w0  x1+s2     ;   mask0:=mask(0:47);
     am     (b1)       ;
     rl  w3  +a29      ;   get last 2 words from
     dl  w0  x3+8      ;     message area;
     ds  w0  x1+s3     ;   mask1:=mask(48:95);
     al  w0  0         ;
     rs  w0  g20       ;   status:=0;
     jl  w3  g18       ;   deliver result1;
     jl     (b20)      ; exit: return to sender;
       
i2:  1<23              ; intervention;
   
e.

; saved w-registers:
f0:  0                 ;  w0
f1:  0                 ;  w1
f2:  0                 ;  w2
f3:  0                 ;  w3

; parameters:
f7:  0                 ;  proc
f8:  0                 ;  buffer
f9:  0                 ;  type, length

; internal test area:
f10: 0, r.12           ; start:
f11=k-f10              ;   size of test area


; check condition(type,on/off).
;  checks the type of the test point stored in link against the test mask.
;  if test is off then the procedure returns to link+4. test on implies
;  that the test record is initiated, the registers are saved and return is made to link+6.
;        call:         return:
; w0                   unchanged
; w1                   unchanged
; w2                   unchanged
; w3     link          saved w3 (off), start(internal test area) (on)
b.i0,j0 w.
f4:  ds. w1  f1.       ; check condition:
     rs. w2  f2.       ;
     rs. w3  i0.       ;   save link;
     rl  w0  x3+2      ;
     rs. w0  f3.       ;   save saved w3;
     rl  w1  b19       ;   proc:=current proc;
     rl  w0  x1+a10    ;
     se  w0  p110      ;   if kind(proc)<>mainprockind then
     rl  w1  x1+a50    ;     proc:=mainproc(proc);
     rl  w0  x1+a10    ;
     se  w0  p110      ;   if kind(proc)<>mainprockind
     jl.     j0.       ;     goto exit2;
     rs. w1  f7.       ;   save proc;
     rl  w3  x3        ;
     sl  w3  48        ;   if type>=48 then
     am      s3-s2     ;     mask:=mask1;
     dl  w1  x1+s2     ;     shift:=type-48;
     sl  w3  48        ;   else
     am      -48       ;     mask:=mask0;
     ld  w1  x3        ;     shift:=type;
     sl  w0  0         ;   if mask shifted shift>=0 then
     jl.     j0.       ;     goto exit2;
     hs. w3  f9.       ;   type:=type of test point;
     dl. w1  f1.       ;
     rl. w2  f2.       ;   restore w0-w2;
     al. w3  f10.      ;   w3:=start(test area);
     am.    (i0.)      ;
     jl      +6        ; exit1: return to link+6;

j0:  dl. w1  f1.       ; exit2:
     dl. w3  f3.       ;   restore w0-w3;
     am.    (i0.)      ;
     jl      +4        ;   return to link+4;

i0:  0                 ; saved link;
e.

; create test record.
;  creates a test record with the format shown above.
;        call:         return:
; w0     first         saved w0
; w1     last          saved w1
; w2                   saved w2
; w3     link          saved w3
b.i10,j10 w.
f5:  al  w1  x1+2      ; create test record:
     ds. w1  i1.       ;   top:=last+2;
     ds. w3  i3.       ;   save w0-w3;
     rl  w1  b19       ;
     rx. w1  f7.       ;   current proc:=mainproc;
     rs  w1  b19       ;   save old buffer;
j0:  rl. w2  i1.       ; start:
     ws. w2  i0.       ;   length(record):=
     al  w2  x2+6      ;     top-first+6;
     hs. w2  f9.+1     ;   save length;
     wa  w2  x1+s0     ;   start(next record):=
     sh  w2 (x1+s1)    ;     start(next record)+length;
     jl.     j2.       ;   if start(next record)>top(test buffer) then
                       ;     goto insert;
j1:  rl  w2  x1+s1     ; insert dummy end record:
     ws  w2  x1+s0     ;   length(dummy record):=top(test buffer)-start(next record);
     sl  w2  1         ;   if length(dummy record)>0 then
     rs  w2 (x1+s0)    ;     dummy record:=0,length;
j5:  al  w0  0         ; send answer:
     rs  w0  x1+s0     ;   start(next record):=0;
     rl  w0  x1+p10    ; get first of corebuffer
     rs  w0  x1+s0     ; next record:=first of corebuffer
     jl.     j0.       ;   goto start;
                       ; insert:
j2:  rx  w2  x1+s0     ;
     al  w1  x2        ;
     rl. w0  f9.       ;   insert
     rs  w0  x1        ;     type, length;
     jl. w3  n9.       ;   get time;
     ds  w3  x1+4      ;   insert time;
     al  w2  x1+4+2    ;
     rl. w3  i0.       ;
j3:  sl. w3 (i1.)      ;   transfer test information;
     jl.     j4.       ;
     rl  w0  x3        ;
     rs  w0  x2        ;
     al  w2  x2+2      ;
     al  w3  x3+2      ;
     jl.     j3.       ;
j4:  rl. w1  f7.       ; exit:
                       ;

     rl. w2  i5.       ; if counter<>-1
     sn. w2  (i6.)     ;  then
     jl.     j6.       ;    begin
                       ;
     al  w2  x2-1      ;      counter:=counter-1;
     rs. w2  i5.       ;
     se  w2  0         ;       if counter=0
     jl.     j6.       ;          then
                       ;            begin
     rl. w2  i6.       ;  
     rs. w2  i5.       ;              connter:=-1;
                       ;
     ld  w0   -100     ;                  testmask(1,2,3,4):=0;
     ds  w0  x1+s2     ;
     ds  w0  x1+s3     ;             end;
                       ;     end;
j6:  rx  w1  b19       ;   restore current proc
     dl. w1  f1.       ;
     dl. w3  f3.       ;   restore w0-w3;
     jl.    (i3.)      ;   return to calling program;

i0:  0                 ;  first
i1:  0                 ;  last
i2:  0                 ;
i3:  0                 ;  link
      
; procedure stop testoutput
; the procedure is called from testpoint 8 and 9
; the procedure stops testoutput by setting the
; variable counter equal  to 25 and signal
; hereby that f5 must produce 26 testrecords
; and then turn the testoutput off by
; setting the testmask to all zeroes
;     
;           call           return
;      
;    w0      --         value before testpoint
;    w1     main        value before testpoint
;    w2      --         value before testpoint
;    w3     link        value before testpoint
;     
;      
f6:  rs. w3  i4.       ; save link
     rl. w2  i5.       ;  if counter=-1
     se. w2  (i6.)     ;     then
     jl.      j7.      ;       begin
                       ;
     al  w2  25        ;
     rs. w2  i5.       ;         counter:=25;
                       ;       end;
j7:  dl. w1  f1.       ; get saved w0,w1
     dl. w3  f3.       ;  get saved w2,w3
        
     jl.     (i4.)      ; return to link
i4:  0                 ; saved link
i5: -1                  ; counter
i6: -1                  ; minus one
            
e.                      ; end of block f5, f6
                       ; *** test ***


;*p4*

; start output.
; start input.
; these procedures start output from or input to an area defined in a block description.
; the status word in the block description is cleared. if io-exception it returns to link else to link+2.
;        call:         return:
; w0                   destroyed
; w1     proc          unchanged
; w2     block desc    unchanged
; w3     link          destroyed
b.i0,j1 w.
n0:  al  w0  0         ; start output:
     rs  w0  x1+p32-2  ;   time(0:47):=0;
     rs  w0  x1+p32    ;
     bz  w0  x2+p21    ;
     ls  w0  8         ;   work:=count out<8+headchar out;
     ba  w0  x2+p20    ;
     jl.     j0.       ;
n1:  bz  w0  x2+p21    ; start input: work:=count in;
j0:  rs. w3  i0.       ;   save link;
c.p101  b.f1 w.
     rs. w3  f0.       ; start test 10
     jl. w3  f4.       ;
     10                ;
f0:  0                 ;
     jl.     f1.       ;
     ld  w0  -100      ;
     sn  w2  x1+p3     ;   if block desc=in desc then
     ds  w0  x1+p52+2  ;      reset 2 words of input area;
     al  w0  x2        ;
     al  w1  x2+p25    ;
     jl. w3  f5.       ;
f1:                    ; end test 10
e.z.
     rl  w3  x2+p25    ;   devno:=devno(block desc);
     io  w0  x3+9      ;   set header and count(dev,work);
     sx      2.11      ;   check exception;
     jl. w2 (i0.)      ;
     rl  w0  x2+p23    ;
     io  w0  x3+1      ;   set last addr(dev);
     sx      2.11      ;   check exception;
     jl. w2 (i0.)      ;
     rl  w0  x2+p22    ;
     io  w0  x3+5      ;   set first addr and start(dev);
     sx      2.11      ;   check exception;
     jl. w2 (i0.)      ;
     al  w0  0         ;
     rs  w0  x2+p24    ;   status(block desc):=0;
     am.    (i0.)      ;
     jl      +2        ; exit: return to link+2;
i0:  0                 ;  saved link
e.


; reset timer1.
; this procedure resets the timer1 of the receiver.
;        call:         return:
; w0                   unchanged
; w1     proc          unchanged
; w2                   unchanged
; w3     link          unchanged
b. w.
n2:  am     (x1+p3+p25); reset timer1:
     io      +2        ;   reset timer1(receiver);
     sx      2.11      ;   check exception;
     jl  w2  x3+0      ;
     jl      x3+2      ; exit: return to link+2;
e.

; sense status.
; this procedure senses the interrupt expander of the scc. status of the inter-
; rupting device(s) is(are) sensed and inserted in the main proc description. the
; procedure returns to
;   link+0    if exception
;       +2    if status(exp)=0
;       +4    if transmitter interrupt
;       +6    if transmitter and receiver interrupt
;       +8    if receiver interrupt.
;
;        call:         return:
; w0                   destroyed
; w1     mainproc      unchanged
; w2                   destroyed
; w3     link          unchanged
b.i2,j0 w.
n3:  rs. w3  i0.       ; sense status:
     io  w0 (x1+a50)   ;   sense status(int expander);
     sx      2.11      ;   check exception;
     jl  w2  x3+0      ;
c.p101  b.f1 w.
     rs. w3  f0.       ; start test 11
     jl. w3  f4.       ;
     11                ;
f0:  0                 ;
     jl.     f1.       ;
     rs  w0  x3        ;
     rl. w0  f0.       ;
     rs  w0  x3+2      ;
     al  w0  x3        ;
     al  w1  x3+2      ;
     jl. w3  f5.       ;
f1:                    ; end test 11
e.z.
     sn  w0  0         ;   if status=0 then
     jl      x3+2      ;     return to link+2;
     so  w0  2.1       ;   if no trm int then
     jl.     j0.       ;     goto recint;
     io  w2 (x1+p2+p25); trmint: sense status(trm);
     sx      2.11      ;   check exception;
     jl  w2  x3+0      ;
     rs  w2  x1+p2+p24 ;   status(out):=status;
     jl. w3  n9.       ;   get time;
     ds  w3  x1+p32    ;   time:=new time;
     rl. w3  i0.       ;
     so  w0  2.10      ;   if no recint then
     jl      x3+4      ;     return to link+4;
j0:  io  w2 (x1+p3+p25); recint: sense status(rec);
     sx      2.11      ;   check exception;
     jl  w2  x3+0      ;
     al  w3  2.11111111;
     la  w3  4         ;
     hs  w3  x1+p3+p20 ;   headchar(in):=status(16:23);
     la. w2  i1.       ;   status:=status excl intervention, carrier lost and headchar;
     bz  w3  5         ;
     ls  w3  -8        ;
     hs  w3  x1+p96+1  ; save sensed count
     al  w3  x2        ;
     lo  w3  4         ;
                       ;
     am      (x1+p3+p25)
     io  w2  +4        ; sense receiver.core store add
     sx      2.11      ; if exceptions
     jl. w2  (i0.)     ;    then return to link;
     rs  w2  x1+p97    ; save sensed core store addr
                       ;
     io  w2  (x1+p3+p25)
     sx      2.11      ;
     jl. w2  (i0.)     ;
     la. w2  i2.       ; sense receiver intervention or carrier lost
     lo  w2  6         ; or previous sensed
     la  w2  g51       ;   mask off status(rec);
     rs  w2  x1+p3+p24 ;
c.p101 b. f1 w.
     rs. w3   f0.
     jl.  w3  f4.
     14
f0:  0
       jl. f1.
     al  w0  x1+p3+p20
     al  w1  x1+p3+p25
     jl. w3  f5.
f1:
e.z.
     rl. w3  i0.       ;
     so  w0  2.11      ;   if rec and trm int then
     jl      x3+8      ;     return to link+6
     jl      x3+6      ;   else return to link+8;
i0:  0                 ; saved link
i1: 8.36711400         ; mask off intervention or carrier lost and headerchar
i2: 8.41000000         ; intervention or carrier lost
e.

; restart receiver.
; this procedure restarts the receiver by either resetting the timer1 - in
; case last sensed status indicates timeout -, or starting a new input.
;        call:         return:
; w0                   destroyed
; w1     main          unchanged
; w2     block desc    unchanged
; w3     link          destroyed
b.w.
n4:  bz  w0  x1+p3+p24 ; restart receiver:
     sz  w0  1<9       ;   if timer status then
     am      n2-n1     ;     goto reset timer1;
     jl.     n1.       ;   else goto start input(block in);
e.


; stop transmitter and receiver.
; stop device.
; stops and resets the receiver (and the transmitter).
;        call:         return:
; w0                   destroyed
; w1     main          unchanged
; w2                   unchanged
; w3     link          unchanged
b. w.
n7:  am     (x1+p2+p25); stop trm and rec:
     io      +10       ;   reset transmitter;
     sx      2.11      ;   check exception;
     jl  w2  x3+0      ;
     al  w0  -1        ;
     hs  w0  x1+p96     ; set after master_clear on
     io  w0 (x1+p2+p25);   sense transmitter;
     sx      2.11      ;   check exception;
     jl  w2  x3+0      ;
n8:  am     (x1+p3+p25); stop rec: 
     io      +10       ;   reset device(block desc);
     sx      2.11      ;   check exception;
     jl  w2  x3+0      ;
     io  w0 (x1+p3+p25);   sense receiver;
     sx      2.11      ;   check exception;
     jl  w2  x3+0      ;
c.p101 b.f1 w.         ;*****test19*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     19                ;
f0:  0                 ;
     jl.     f1.       ;
     rs  w0  x3        ;   param0:=sensed receiver status;
     rl. w0  f0.       ;
     rs  w0  x3+2      ;   param1:=link;
     al  w0  x3        ;
     al  w1  x3+2      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test19*****
     jl      x3+2      ; exit: return to link+2;
e.


; check and wait.
; timer:=time elapsed since last transmitter int - wait ready time.
;    if time=0 (=> transmitter is busy) then return to link.
;    if timer>0 then wait(timer) and then return to link+2.
;    if timer=<0 then return to link+2.
;
;        call:         return:
; w0                   unchanged
; w1     mainproc      unchanged
; w2                   unchanged
; w3     link          destroyed
b.i1,j1 w.
n5:  ds. w3  i1.       ; check and wait:
     rl  w3  x1+p32-2  ;
     lo  w3  x1+p32    ;
     sn  w3  0         ;   if time=0 then
     jl.    (i1.)      ; exit0: return to link;
     jl. w3  n9.       ;   get time(newtime);
     ss  w3  x1+p32    ;   deltatime:=newtime-time;
     sh  w2  0         ;   if time(0:23)
     sh  w3  -1        ;   or time(24:24)=0 then
     jl.     j1.       ;     goto exit1;
     ws  w3  x1+p34    ;   timer:=max wait ready time-deltatime;
c.p101  b.f1 w.
     rs. w3  f0.       ; start test 12
     jl. w3  f4.       ;
     12                ;
f0:  0                 ;
     jl.     f1.       ;
     rl. w0  f0.       ;
     rs  w0  x3        ;
     al  w0  x3        ;
     al  w1  x3        ;
     jl. w3  f5.       ;
f1:                    ; end test 12
e.z.
                       ; to avoid internal interrupt
                       ; the value of max wait ready
                       ; time must not exceed 2048;
     as  w3  3         ;   w3:=-timer (in units of 12.5 usec);
j0:  al  w3  x3+1      ; wait busy loop:
     rx  w0  0         ;   only used as fill to make time
     sh  w3  0         ;   of loop = 12.5 usec;
     jl.     j0.       ;
j1:  dl. w3  i1.       ; exit1:
     jl      x3+2      ;   return to link+2;
i0:  0                 ; saved w2
i1:  0                 ; saved link
e.


; set parameters.
; turns on the 'data terminal ready' and the 'request to send' signals.
;        call:         return:
; w0                   destroyed
; w1     mainproc      unchanged
; w2                   unchanged
; w3     link          unchanged
b. w.
n6:  al  w0  2.11      ; set parameters: parameters:=
     am     (x1+p2+p25);    data terminal ready, request to send;
     io  w0  +13       ;   set parameters(trm);
     sx      2.11      ;    check exception;
     jl  w2  x3+0      ;
     jl      x3+2      ; exit: return to link+2;
e.


; get time.
;        call:         return:
; w0                   unchanged
; w1                   unchanged
; w2                   time(0:23)
; w3     link          time(24:47)
b.i0 w.
n9:  rs. w3  i0.       ; get time:
     jl  w3  d7        ;   time(usec, slice);
     al  w2  0         ;
     aa  w3  b13+2     ;   time:=time+usec;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link
e.


; packout.
; packs out a received header and inserts the parameters
; in the receive parameter area in the process description of main
;    
;              call                return
;     w0                          undefined
;     w1     mainproc             unchanged
;     w2                          unchanged
;     w3      link                undefined
        
b. i10 w.
n10:                   ; packout:
     ds. w3  i0.       ; save w2,w3
     rl  w3  x1+p53-14 ;
     ls  w3  -8        ;
     la  w3  g53       ;   local function:=local function(rec);
     hs  w3  x1+p99    ;
     al  w3  0         ;
     rl  w0  x1+p53    ; get mode,status(header)
     ld  w0  3         ;
     ls  w0  -11       ;
     rs  w0  x1+p83    ; status(rec):=status(header)
     hs  w3  x1+p82    ; result(rec):=result(header)
     rl  w3  x1+p53-2  ;
     ld  w0  -8        ;
     ls  w0  -16       ;
     hs  w0  x1+p81    ; function(rec):=function(header)
     la w3  g53        ; last eight bits
     hs  w3  x1+p88    ; bufno(rec):=bufno(header)
     dl  w3  x1+p53-2  ;
     ld  w3  -8        ;
     ls  w3  -8        ;
     rs  w3  x1+p84    ; size(rec):=size(header)
     ld  w3  -10       ;
     hs  w2  x1+p94    ;   data quality(rec):=data quality(header);
     ls  w3  -14       ;
     hs  w3  x1+p89    ; receiver lnkno(rec):=receiver lnkno(header)
     bz  w0  x1+p99    ;
     se  w0  3         ;
     jl.     i10.      ;
     bz  w0  x1+p98    ;
     hs  w3  x1+p98    ;
     hs  w0  x1+p89    ;
     rl  w3  0         ;
i10:                   ;
     ls  w3  1         ;
     wa  w3  b4        ;
     rl  w3  x3        ;
     rs  w3  x1+p90    ; using subproc(rec):= proc descrp proc(rcno)
     rl  w0  x1+p53-6  ; 
     la. w0  i4.       ; last ten bits
     hs  w0  x1+p98    ; sender lnkno(rec):=sender lnkno(header)
     dl  w3  x1+p53-10 ;
     ld  w3  -8        ;
     ls  w3  -8        ;
     rs  w3  x1+p93    ; sender host-id(rec):=sender host-id(header)
     ld  w3  -8        ;
     ls  w3  -16       ;
     hs  w3  x1+p92    ; sender home reg(rec):=sender home reg(header)
     hs  w2  x1+p91    ; sender net-id(rec):=sender net-id(header)
     rl. w2  i2.       ; get saved w2
     jl.     (i0.)     ; exit: return
        
i2:  0                 ; saved w2
i0:  0                 ; saved link
i4:  8.1777            ; mask last ten bits
    
e.
           
         
        
; packin
; builds up a header in the std out area by use of transmitparameters
; the procedure returns to link in case of error in the trm-parameters,
; else to link + 2
;        
;                 call                return
;     w0                            undefined
;     w1       mainproc             unchanged
;     w2                            unchanged
;;    w3        link                undefined
          
b. i10,j10 w.
n11:                   ; packin:
     ds. w3  i0.       ; save w2,w3
        
     bz  w0  x1+p62    ; pack state, mode
     ls  w0  13        ;
     lo  w0  x1+p63    ; get mode
     ls  w0  8         ;
     rs  w0  x1+p51    ; std out(+16):=state shift 21 + m0de shift 8
        
     bz  w2  x1+p74    ; get various(trm)
     bz  w0  x1+p61    ;
     bz  w3  x1+p69    ; get receiver linkno(trm)
     ls  w3  14        ;
     ld  w3  10        ;
     rl  w3  x1+p64    ; get size(trm)
     bz  w0  x1+p68    ; get bufno(trm)
     ls  w0  16        ;  
     ld  w0  8         ;
     ld  w3  8         ;
     bz  w0  x1+p61    ; get function(trm)
     lo  w3  0         ;
     ds  w3  x1+p51-2  ; std out(+12,+14):=data quality shift 18+rec lnkno shift 8 +
                       ;    8 msb of size, 8 lsb of size shift 16 + bufno shift 8 + function
; pack *format(message)* , sender linkno in std out
           
     bz  w0  x1+p78    ; get sender linkno(trm)
     rs  w0  x1+p51-6  ; std out(+10):=0 shift 10 + sender linkno
        
; pack *facility mask* in std out
        
     al  w0  0         ;
     rs  w0  x1+p51-8  ; std out(+8):=0
        
; pack *receiver net-id* , receiver home reg, receiver host-id ans packet-id in std out
    
     bz  w3  x1+p71    ; get receiver net-id
     bz  w0  x1+p72    ; get receiver home reg
     ls  w0  16        ;
     ld  w0  8         ;
     rl  w0  x1+p73    ; get receiver host-id
     ls  w0  8         ;
     ld  w0  8         ;
          
     ds  w0  x1+p51-10 ; std out(+4,+6):=rec net-id shift 16 + rec home reg shift 8 +
                       ;    8 msb of host-id, 8 lsb of host-id shift 16 + 0
     
; pack size,control,*retransmission*,local function,*format(packet)*,*priority*
c.-1
     rl  w3  x1+p66    ;
     ws  w3  x1+p65    ;   size(packet):=
     al  w0  x3+6      ;     last-first+3-bytecount;
     ls  w0  -1        ;
     wa  w3  0         ;
     bs  w3  x1+p67    ;
z.
         
     rl  w3  x1+p64    ;
     ls  w3  8         ; w3:=size(trm) shift 8
      
     bz  w0  x1+p61    ; if function(trm) implies
     so  w0  2.1       ;       no data follows
     al  w3  0         ;           then w3:=0 ;
        
     al  w0  0         ; w0:=0 ;
        
     ds  w0  x1+p51-14 ; std out(+0,+2):= w3,w0 :=size shift 8 + 2 msb of control,
                       ;                 8 lsb of control,shift 16 + retransmission shift 15
                       ;                 + local function shift 8 + format(packet) shift 2
                       ;                 + priority
; normal return
      
     rl. w2  i2.       ; reestablish w2
     am.     (i0.)     ;
     jl      +2        ; return to link + 2
       
i2:   0                ; saved w2
i0:   0                ; saved w3
      
e.


; queue out(sub).
; removes a subprocess from the process queue of the mainprocess.
;        call:         return:
; w0                   unchanged
; w1                   unchanged
; w2     subproc       unchanged
; w3     link          destroyed
b.i6 w.
v103:                  ;
n12: ds. w3  i1.       ; queue out:
     al  w2  x2+p14    ;
     jl  w3  d5        ;   remove element;
     rl. w2  i0.       ;
     jl.    (i1.)      ; exit: return;
i0:  0                 ; saved w2
i1:  0                 ; saved link
e.


; initiate proc desc.
; clears the process description of the mainproc and inserts the
; proper values of devnumbers of the receiver and the transmitter.
;        call:         return:
; w0                   destroyed
; w1     mainproc      unchanged
; w2                   unchanged
; w3     link          destroyed
b.i1,j0 w.
n13: rs. w3  i0.       ; initiate proc desc:
     al  w3  x1+p2     ;
     rl  w0  x1+p34    ;
     rs. w0  i1.       ;   save max wait time;
     al  w0  0         ;
j0:  rs  w0  x3        ;   clear proc desc; 
     al  w3  x3+2      ;
c.p201                 ;
     am      p244-p243 ; dont clear statistic part
z.
     se  w3  x1+p100   ;
     jl.     j0.       ;
     rl  w3  x1+a50    ;
     al  w3  x3+2<6    ;
     rs  w3  x1+p2+p25 ;   devno(trm):=devno(intexp)+2;
     al  w3  x3-1<6    ;
     rs  w3  x1+p3+p25 ;   devno(rec):=devno(trm)-1;
     al  w3  1         ;
     rs  w3  x1+p43    ;   ackrec:=1;
     al. w3  h98.      ;
     rs  w3  b101      ;   return addr(subprocess):=return point in comm. block;
     rl. w3  i1.       ;
     rs  w3  x1+p34    ;   restore max wait time;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link
i1:  0                 ; saved max wait time;
e.


; clear all subprocesses(main).
;        call:         return:
; w0                   destroyed
; w1     main          unchanged
; w2                   destroyed
; w3     link          destroyed
b.i0,j0 w.
n14: rs. w3  i0.       ; clear subprocesses:
     al  w2  x1+p202   ;   proc:=host;
     jl. w3  n16.      ;   clean subprocess(proc);
     al  w2  x2+p19    ;
     al  w0  0         ;
j0:  rs  w0  x2        ;   for bufno:=0,1,..,v3-1 do
     al  w2  x2+2      ;     message(bufno):=0;
     sh  w2  x1+p100-a48+p19+v3<1-2 ;
     jl.     j0.       ;
     al  w0  0         ;   host-id:=undefined;
     jl. w3  n15.      ;   clear subprocesses(host-id,main,net-id);
     jl.    (i0.)      ; exit: return;
i0:  0                 ;   saved link
e.


; clear subprocesses(host-id,main,net-id).
; the procedure clears all subprocesses that are connected to the device
; host in question. if the host-id has dummy value (=0) then all
; subprocesses connected to the main process are cleared.
;        call          return
; w0     host-id       destroyed
; w1     main          unchanged
; w2     net-id        destroyed
; w3     link          destroyed
b.i6,j6 w.
n15: ds. w1  i1.       ; clear subprocesses:
     ds. w3  i3.       ;   save w0-w3;
     rl  w3  b4        ;   entry:=first entry in name table ;
     al  w3  x3-2      ;
j0:  al  w3  x3+2      ; next: entry:=next entry in name table;
     sl  w3 (b5)       ;   if entry>last dev entry then
     jl.    (i3.)      ; exit: return;
     rl  w2  x3        ;   proc:=proc(entry);
     se  w1 (x2+a50)   ;   if mainproc(proc)<>mainproc then
     jl.     j0.       ;     goto next;
     rl. w0  i0.       ;
     sn  w0  0         ;   if host-id<>dummy then
     jl.     j1.       ;     if host-id<>host-id(sub)
     se  w0 (x2+p5)    ;     or net-id<>net-id(sub) then
     jl.     j0.       ;       goto next;
;    bz  w0  x2+p7     ;
;    se. w0 (i2.)      ;***fjernet indtil net-id er defineret
;    jl.     j0.       ;
j1:  rs. w3  i4.       ;
     rl  w0  x2+a10    ;
     sn  w0  p112      ;   if proc=local subproc then
     jl.     j2.       ;     clean subproc(proc);
     se  w0  p113      ;   if proc=remote subproc then
     jl.     j0.       ;     remove remote subproc;
     am      +2        ;
j2:  jl. w3 (i5.)      ;
j3:  rl. w3  i4.       ;
     jl.     j0.       ;
i0:  0                 ;   saved host-id
i1:  0                 ;   saved main
i2:  0                 ;   saved net-id
i3:  0                 ;   saved link
i4:  0                 ;   name table address
i5:  v101              ;   address of clean subproc
i6:  v102              ;   address of remove remote subprocess
e.

; clean subproc(proc).
; cleans the sub process by returning all messages in the mess buffer queue with dummy answer.
;        call:         return:
; w0                   destroyed
; w1                   unchanged
; w2     sub           unchanged
; w3     link          destroyed
b.i3 w.
v101:                  ;
n16: rs. w3  i0.       ; clean subproc:
     rs. w1  i1.       ;   save w1;
     al  w1  x2        ;
     rx  w2  b19       ;   cur proc:=sub;
     rs. w2  i2.       ;   save old curr proc;
     jl. w3 (i3.)      ;   clear subproc message queue;
     dl. w2  i2.       ;
     rx  w2  b19       ;   curr proc:=old curr proc;
     jl. w3  n12.      ;   queue out;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link
i1:  0                 ; saved w1
i2:  0                 ; saved old curr proc
i3:  v100              ;   address of clear subproc mess queue;
e.



;*p5*

b.i20,j30 w.

; master clear.
;  call: w1: mainproc  w2: blockout description
m0:  jl. w3  n7.       ; master clear: stop transmitter and receiver;
     jl.     m10.      ;    ex: goto exception;
     jl. w3  n6.       ;   set parameters;
     jl.     m10.      ;    ex: goto exception;
     jl.     j0.       ;   goto cont;


; transmit-recieve.
; this block starts a transmission of a block which is defined in the
; block-out description. next it starts a receive operation according
; to the standard block-in description and waits for termination of
; the input or output operation.
;  call: w1: mainproc , w2: block-out desc 
m1:  rl  w0  x1+p30    ; transmit-receive:
     sn  w0  0         ;   if req=0 then
     jl.     j0.       ;     goto cont;
     jl. w3  n5.       ;   check and wait;
     jl     (b20)      ;    trm busy: return to program;
     al  w0  0         ;   req:=0;
     rs  w0  x1+p30    ;  cont:
j0:  jl. w3  n0.       ;   start output(block-out);
     
     jl.     q0.       ;    ex: goto master clear;
     al  w2  x1+p3     ;   block-in desc:=std block-in desc;
     jl. w3  n1.       ;   start input(block-in desc);
     
     jl.     q0.       ;    ex: goto master clear;
j1:  c.p201            ; ***statistic***
     jl. w3  n9.       ; get time
     ds  w3  x1+p216 z.; save time
                       ; ***statistic***
     jl  w3  c32       ; wait1: wait interrupt;
     am      0         ; intres1:
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ss  w3  x1+p216   ;
     ds  w3  x1+p216   ; wait1 time:=get time - save time
z.                     ; ***statistic***
     jl. w3  n3.       ;   sense status;
     
     jl.     q0.       ;    ex: goto master clear;
     jl.     j1.       ;    noint: goto wait1;
     jl.     j6.       ;    trm: goto check req;
     jl.     m5.       ;    trmrec: goto check and branch;
     al  w2  x1+p3     ;    rec:
     jl. w3  n4.       ;   restart receiver;
     
     jl.     q0.       ;    ex: goto master clear;
     jl.     j1.       ;   goto wait1;


; receive.
; starts the receive operation according to the standard block-in description
; and waits for interrupt.
;  call: w1: mainproc
m2:  al  w2  x1+p3     ; receive:
     jl. w3  n1.       ;   start input(std block-in desc);
     
     jl.     q0.       ;    ex: goto master clear;
j2:  c.p201            ; ***statistic***
     jl. w3  n9.       ; get time
     ds  w3  x1+p217   ; save time
z.                     ; ***statistic***
     jl  w3  c32       ; wait2: wait interrupt;
     am      0         ; intres2:
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ss  w3  x1+p217   ;
     ds  w3  x1+p217   ; wait2 time:=get time - save time
z.                     ; ***statistic***
     jl. w3  n3.       ;   sense status;
     
     jl.     q0.       ;    ex: goto master clear;
     jl.     j2.       ;    noint: goto wait2;
     jl.     q0.       ;    trm: goto master clear;
     jl.     q0.       ;    trmrec: goto master clear;
     jl.     m5.       ;    rec: goto check and branch;


; transmit.
; this block starts a transmission using the block out description defined
; in the call and waits for an interrupt.
;  call: w1: mainproc , w2: block-out desc
m3:  jl. w3  n5.       ; transmit: check and wait;
     jl     (b20)      ;    trm busy: return to program;
     jl. w3  n0.       ;   start output(block out);
     
     jl.     q0.       ;    ex: goto master clear;
j3:  c.p201            ; ***statistic***
     jl. w3  n9.       ; get time
     ds  w3  x1+p218   ; save time
z.                     ; ***statistic***
     jl  w3  c32       ; wait3: wait interrupt;
     am      0         ; intres3:
c.p201                 ; ***statistic***
     jl. w3  n9.       ; 
     ss  w3  x1+p218   ;
     ds  w3  x1+p218   ; wait3 time:=get time - save time
z.                     ; ***statistic***
     jl. w3  n3.       ;   sense status;
     
     jl.     q0.       ;    ex: goto master clear;
     jl.     j3.       ;    noint: goto wait3;
     jl.     j7.       ;    trm: goto trm3;
     jl.     j8.       ;    trmrec: trmrec3;
                       ;    rec:
j4:  c.p201            ; ***statistic***
     jl. w3  n9.       ; get time
     ds  w3  x1+p219   ; save time
z.                     ; ***statistic***
     jl  w3  c32       ; wait4: wait interrupt;
     am      0         ; intres4:
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ss  w3  x1+p219   ;
     ds  w3  x1+p219   ; wait4 time:=get time - save time
z.                     ; ***statistic***
     jl. w3  n3.       ;   sense status;
     
     jl.     q0.       ;    ex: goto master clear;
     jl.     j4.       ;    noint: goto wait4;
     jl.     j8.       ;    trm: goto trmrec3;
     jl.     q0.       ; trmrec: goto master clear;
     jl.     q0.       ; rec: goto master clear;


j7:  al  w0  2         ; trm3:
     rs  w0  x1+p30    ;   req:=2;
     jl.     j2.       ;   goto wait2;

j8:  al  w0  2         ; trmrec3:
     rs  w0  x1+p30    ;   req:=2;
     jl.     m5.       ;   goto check and branch;


; reset timer.
; resets the timer of the receiver and waits for an interrupt as after
; receive.
;  call: w1: mainproc
m4:  jl. w3  n2.       ; reset timer: reset timer1;
     
     jl.     q0.       ;    ex: goto master clear;
     am      2-1       ;   if req=2
j6:  al  w0  1         ; check req: or 1 then
     sn  w0 (x1+p30)   ;     goto sendreq;
     jl.     q11.      ;   goto wait2;
     jl.     j2.       ;


; start.
;  call: w1: mainproc
m6:  jl. w3  n7.       ; start: stop transmitter and receiver;
     
     jl.     q0.       ;    ex: goto master clear;
     jl. w3  n6.       ;   set parameters;
     
     jl.     q0.       ;    ex: goto master clear;
     jl.     m2.       ;   goto receive;


; exception.
m10:                   ; exception:
c.p101  b.f1 w.
     rs. w3  f0.       ; start test 5
     xs      3         ;
     jl. w3  f4.       ;
     5                 ;
f0:  0                 ;
     jl.     f1.       ;
     bz  w0  3         ;
     rs  w0  x3        ;
     al  w0  x3        ;
     al  w1  x3        ;
     jl. w3  f5.       ;
     jl. w3  f6.       ;   stop testoutput;
f1:                    ; end test 5
e.z.
     rl  w1  b19       ;
     jl      c33       ; exit: goto dummy interrupt;


; check and branch.
; this routine computes a state by use of status of reciever, expstate and
; the recieved control field. the state is used to branch to the proper action.
;
; state:   status    headchar           control
;
;   0       ok        <soh>             master clear
;   2      timer1       -                 -
;   4        -        <enq>               -
;   6        -       <>exp headchar       -
;   8      error        -                 -
;  10       ok        <stx>               -
;  10       ok        <soh>              ack
;  12       ok        <soh>             header
;  14       ok        <soh>             ack-header
;  16       ok        <soh>             nack,
;                                       error(ackcount),
;                                       request for line
;
; the values of expstate are:
;  <value>    <last send>.<expected block>
;     0           tecnical mode
;     2           ack    .    header
;     4           ack    .    data
;     6       ack-header .    ack
;     8           data   .    ack
;    10           header .    ack
;    12       ack-header .    ack ; in master clear sequence
;
;  entry: w1: mainproc
;  exit:  w1: mainproc , w2: expstate , w3: state

m5:  bz  w0  x1+p3+p24 ; check and branch:
     so. w0  (i12.)    ; if status receiver = intervention
     sz  w0  1<6       ;  or carrier lost
     jl.     j14.      ;   then goto start;
     bl  w2  x1+p96    ; if after master 
     sl  w2  0         ;  clear operation
     jl.     j21.      ;    on transmitter
                       ; then
     al  w2  0         ;   begin
     hs  w2  x1+p96    ;     switch after master clear off
                       ;
     rl  w2  x1+p97    ;    if sensed core
     se  w2  x1+p53+2  ;        store address <> last_in + 2
     jl.     j14.      ;          then goto state8;
                       ;
     bz  w2  x1+p96+1  ;     if sensed
     se  w2  2.1       ;         count <> 2.1
     jl.     j14.      ;          then goto state8;
                       ;
     la. w0  i13.      ;      remove timeout bit;
                       ;   end;
j21: sz  w0  1<9       ;   if timer1 status then
     jl.     j11.      ;     goto state2;
     bz  w2  x1+p3+p20 ;
     sn  w2  p105      ;   if headchar in=<enq> then
     jl.     j12.      ;     goto state4;
     sz  w0  8.2400    ;   if status(in)=parity error or data overrun then
     jl.     j14.      ;     goto state8;
     bz  w3  x1+p40    ;   if expstate=ack.data then
     sn  w3  4         ;     expheadchar:=<stx>
     am      p104-p102 ;   else expheadchar:=<soh>;
     se  w2  p102      ;   if headchar<>expheadchar then
     jl.     j13.      ;     goto state6;
     sn  w2  p104      ;   if headchar=<stx> then
     jl.     j15.      ;     goto state10;
     dl  w0  x1+p52+2  ; check control field:
     ld  w0  -2        ;
     ls  w0  -14       ; w0:=control(0:9)
     al  w3  2.111<7   ;
     la  w3  0         ;
     ls  w3  -7        ;
     rs  w3  x1+p39    ;   type:=type(header);
     sn  w3  2.010     ;   if type=req for line then
     jl.     j18.      ;     goto state16;
     sn  w3  2.100     ;   if type=master clear then
     jl.     j10.      ;     goto state0;
     so  w0  1<6       ;   if not enable ack then
     jl.     j16.      ;     goto state12;
     so  w0  1<5       ;   if nack then
     jl.     j18.      ;     goto state16;
     bz  w3  x1+p42    ;
     ls  w3  4         ;   if bit5(control)<>acktr mod 2 then
     lx  w3  0         ;     goto state16;
     sz  w3  1<4       ;
     jl.     j18.      ;
     al  w3  2.1100    ;
     la  w3  0         ;
     ls  w3  -2        ;
     hs  w3  x1+p41    ;   control:=blockcontrol;
     so  w0  1<1       ;   if no header bit then
     jl.     j15.      ;     goto state10;
     jl.     j17.      ;   goto state14;

j10: am      0 - 2     ; state0 : state:=0  (master clear)
j11: am      2 - 4     ; state2 : or     2  (timeout)
j12: am      4 - 6     ; state4 : or     4  (enquiry)
j13: am      6 - 8     ; state6 : or     6  (headchar error)
j14: am      8 -10     ; state8 : or     8  (status error)
j15: am      10-12     ; state10: or     10 (ack, or data)
j16: am      12-14     ; state12: or     12 (header)
j17: am      14-16     ; state14: or     14 (ack-header)
j18: al  w3  16        ; state16: or     16 (nak, error(ackcount),req)
     bz  w2  x1+p40    ;
c.p101  b.f1 w.
     rs. w3  f0.       ; start test 3
     jl. w3  f4.       ;
     3                 ;
f0:  0                 ;
     jl.     f1.       ;
     rl  w0  x1+p40    ;
     rs  w0  x3        ;   param0:=expstate, control;
     rl. w0  f0.       ;
     hs  w0  x3+2      ;   param1:=state, headchar(in);
     bz  w0  x1+p3+p20 ;
     hs  w0  x3+3      ;
     rl  w0  x1+p3+p24 ;   param2:=status(in);
     rs  w0  x3+4      ;
     al  w0  x3        ;
     al  w1  x3+4      ;
     jl. w3  f5.       ;
f1:                    ; end test 3
e.z.
c.p101  b. f3 w.
     rs. w3  f0.
     jl. w3  f4.
     18                ;
f0:  0
     jl.     f1.
     al  w0  x1+p50
     al  w1  x1+p53
     jl. w3  f5.
f1:
e.z.
c.p201                 ;
     ds. w3  i11.      ;
     jl. w3  n9.       ;
     ds  w3  x1+p243   ; now time:= get time
                       ;
     ss  w3  x1+p220   ;
     ss  w3  x1+p216   ;
     ss  w3  x1+p217   ; m_code_time:= now time
     ss  w3  x1+p218   ;  -m_call_time - wait1
     ss  w3  x1+p219   ;
     aa  w3  x1+p239   ;  -wait2 - wait3
     ds  w3  x1+p239   ;  - wait4 + m_code_time;
                       ;
     dl  w3  x1+p220   ;
     ss  w3  x1+p221   ; q_code_time:= m_call_time
     aa  w3  x1+p238   ;  - q_call_time + q_code_time
     ds  w3  x1+p238   ;
                       ;
     dl  w3  x1+p243   ;
     rl  w0  x1+p235   ;
     ls  w0  2         ; w0:= displ from t0-entry-time;
     am      (0)       ; total time:=
     ss  w3  x1+p222   ;   now time - t.curr-entry time;
     ds  w3  x1+p236   ;
                       ; comment req_call_time is placed
                       ;         -4 bytes before t0-entry-time;
     rl  w2  x1+p226   ;
     sn  w2  1         ; t_code_time := q_call_time
     al  w0  -4        ;    - ( if req for line
     dl  w3  x1+p221   ;            then req_call_time
     am      (0)       ;            else t.curr-entry-time )
     ss  w3  x1+p222   ;    + t_code_time;
     aa  w3  x1+p237   ;
     ds  w3  x1+p237   ;
                       ;
     al  w2  x1+p215+2 ;
     al  w3  x1+p243   ;
c.p201 b. f1 w.        ;
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     13                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p244   ;
     al  w1  x1+p241   ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;
     al  w0  0         ;
j19: rs  w0  x2        ;
     al  w2  x2+2      ;
     sh  w2  x3        ;
     jl.     j19.      ;
     dl. w3  i11.      ;
z.                     ; ***statistic***

     sn  w2  0         ;
     jl.    (i0.)      ;
     am.    (x2+i0.)   ;
     jl     (x3)       ;   goto action(expstate,state);

i0:  t12               ;  (0: tecnical mode,
     i2                ;   2: ack.header,
     i3                ;   4: ack.data,
     i4                ;   6: ack-header.ack,
     i5                ;   8: data.ack,
     i6                ;  10: header.ack,
     i7                ;  12: ack-header.ack in master clear sequence);

; state: 0     2     4     6     8     10    12    14    16    ; expstate:

i2:      t0 ,  q1 ,  q5 ,  q2 ,  q7 ,  q7 ,  t1 ,  q7 ,  q7    ;   2
i3:      t0 ,  q2 ,  q5 ,  q2 ,  q7 ,  t2                      ;   4
i4:      t0 ,  q3 ,  q5 ,  q2 ,  q2 ,  t3 ,  q2 ,  t5 ,  q2    ;   6
i5:      t0 ,  q6 ,  q6 ,  q6 ,  q6 ,  t7 ,  q6 ,  t8 ,  q4    ;   8
i6:      t0 ,  q0 ,  q0 ,  q0 ,  q0 ,  t4 ,  q0 ,  t6 ,  q0    ;  10
i7:      t0 ,  q3 ,  q5 ,  q2 ,  q2 ,  q0 ,  q2 , t15 ,  q2    ;  12
c.p201
i10: 0
i11: 0
z.
i12:  1<11              ; intervention bit
i13: -1-1<9             ; timeout bit

e.


;*p5*

; internal block description:
r0:  0                 ; headchar , count
     r1                ; first addr
     r2                ; last addr
     0                 ; status (not used)
     0                 ; devno
     
r1:  0<8+1             ; the packed header is used
     0                 ; to send request for line
     0                 ; or enquiry. the type
     0                 ; field in control is permanent
     0                 ; equal to request for line as
     0                 ; this field is dummy in
     0                 ; case of enquiry. the rest
     0                 ; of the header is dummy
r2:  0                 ; in both situations.

r3:  p102<12+2.01      ; soh ,  count(soh-block)
r4:  p105<12+2.01      ; enq ,  count(soh-block)
r5:  p104<12           ; stx ,  0
     
r7:  2.100 000 00 10<8+0<7+1  ; control:=master clear, retrm:=0, loc function:=1

r8:  2.110 111 00 10<8+0<7+2  ; control:=answer master clear, retrm:=0, loc function:=2

c.p101
; stepping stones.
     jl.     f4.       ;
f4=k-2                 ;
     jl.     f5.       ;
f5=k-2                 ;
     jl.     f6.       ;
f6=k-2                 ;
z.


;*p6*

b.i10,j10 w.

; send master clear.
q0:                    ; send master clear:
c.p101  b.f1 w.
     rs. w3  f0.       ; start test 7
     jl. w3  f4.       ;
     7                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p11    ;
     al  w1  x1+p100-2 ;
     jl. w3  f5.       ;
f1:                    ; end test 7
e.z.
jl. w3 n14. ; clear all subprocesses....midlertidig placering
     jl. w3  n13.      ;   initiate proc desc;
     al  w3  0         ; size:=0
     rl.  w0 r7.       ; type:=master clear, header:=1
     ld  w0  8         ; retrm:=0
     ds  w0  x1+p50+2  ; loc function:=1
     al  w2  x1+p50    ;
     al  w3  x1+p51    ;
     ds  w3  x1+p2+p23 ;   out area:=std out area;
     rl. w3  r3.       ;
     rs  w3  x1+p2+p20 ;
     al  w2  x1+p52    ;
     al  w3  x1+p53    ;
     ds  w3  x1+p3+p23 ;   in area:=std in area;
     rl. w3  r3.       ;
     rs  w3  x1+p3+p20 ;   headchar, count in:=<soh>, 0;

c.p201 b. f1 w.        ; *** test 8 ***
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     8                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ; no parameters
     jl. w3  f5.       ;
     jl. w3  f6.       ; stop testoutput
f1:                    ;
e.z.                   ; *** end test 8 ***
c.p201                 ; ***statistic***
     rl  w0  x1+p245   ;
     ba. w0  1         ; no of master clears send:=
     rs  w0  x1+p245   ; no of master clears send + 1 ;
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time
z.                     ; ***statistic***
     al  w2  x1+p2     ;   w2:=std out desc;
     jl.     m0.       ;   goto master clear;


; clear timer.
q1:  al  w3  0         ; clear timer:
     rs  w3  x1+p44    ;   clear count0, count1;
     se  w0 (x1+p31)   ;   if first waiting <> 0 then
     jl.     q11.      ;     goto send request for line;
     bz  w3  x1+p47    ;   clear timer0;
     al  w3  x3+1      ;
     rs  w3  x1+p46    ;   timer1:=timer1+1;
c.p201                 ; ***statistic***
     rl  w0  x1+p204   ;
     ba. w0  1         ; no of clear timer:=
     rs  w0  x1+p204   ; no of clear timer + 1;
z.                     ; ***statistic***
     sl  w3  p147      ;   if timer1>=maxtimer1 then
     jl.     q0.       ;     goto send master clear;

c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time
z.                     ; ***statistic***
     jl.     m4.       ;   goto reset timer;


; restart0.
; restarts the receiver in waiting for a block defined in the std block description.
q2:  al  w3  0         ; restart0:
     hs  w3  x1+p45    ;   clear count1;
     hs  w3  x1+p46    ;   clear timer0;
     bz  w3  x1+p44    ;
     al  w3  x3+1      ;   count0:=count0+1;
     hs  w3  x1+p44    ;
c.p201                 ; ***statistic***
     rl  w0  x1+p205   ;
     ba. w0  1         ; no of restart0:=
     rs  w0  x1+p205   ; no of restart0 + 1;
z.                     ; ***statistic***
     sl  w3  p144      ;   if count0>=maxcount0 then
     jl.     q0.       ;     goto send master clear;
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time ;
z.                     ; ***statistic***
     jl.     m2.       ;   goto receive;


; restart1.
; restarts the receiver. 
q3:  al  w3  0         ; restart1:
     rs  w3  x1+p44    ;   clear count0, count1;
     bz  w3  x1+p46    ;
     al  w3  x3+1      ;   timer0:=timer0+1;
     hs  w3  x1+p46    ;
c.p201                 ; ***statistic***
     rl  w0  x1+p206   ;
     ba. w0  1         ; no of restart1:=
     rs  w0  x1+p206   ; no of restart1 + 1
z.                     ; ***statistic***
     sl  w3  p146      ;   if timer0>=maxtimer0 then
     jl.     q0.       ;     goto send enquiry;
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time
z.                     ; ***statistic***
     jl.     m2.       ;   goto receive;


; retransmit0.
; retransmits a block defined in the block out desciption and counts
; up the error counter.
q4:  al  w3  0         ; retransmit0:
     rs  w3  x1+p46    ;   clear timer0, timer1;
     bz  w3  x1+p45    ;
     al  w3  x3+1      ;   count1:=count1+1;
     rs  w3  x1+p44    ;
c.p201                 ; ***statistic***
     rl  w0  x1+p207   ;
     ba. w0  1         ; no of retransmit0:=
     rs  w0  x1+p207   ; no of retransmit0 + 1
z.                     ; ***statistic***
     sl  w3  p145      ;   if count1>=maxcount1 then
     jl.     q0.       ;     goto send master clear;
                       ;   goto transmit-receive;


; retransmit1.
; retransmits a block defined in the std output description, and waits for input.
q5:  al  w2  x1+p2     ; retransmit1: block out:=std block out;
c.p201                 ; ***statistic***
     rl  w2  x1+p208   ;
     al  w2  x2+1      ; no of retransmit1:=
     rs  w2  x1+p208   ; no of retransmit1+1
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time
     al  w2  x1+p2     ;
z.                     ; ***statistic***
     jl.     m1.       ;   goto transmit-receive;


; send enquiry.
; transmits an enquiry block by use of the internal block description, and starts the receiver.
q6:  al  w3  0         ; send enquiry:
     hs  w3  x1+p45    ;   clear count1;
     rs  w3  x1+p46    ;   clear timer0, timer1;
     bz  w3  x1+p44    ;
     al  w3  x3+1      ;   count0:=count0+1;
     hs  w3  x1+p44    ;
     sl  w3  p144      ;   if count0>=maxcount0 then
     jl.     q0.       ;     goto send master clear;
     rl. w3  r4.       ;
     rs. w3  r0.       ;   headchar:=<enq>;
     rl  w3  x1+p2+p25 ;
     rs. w3  r0.+p25   ;   devno:=devno(trm);
     al. w2  r0.       ;
c.p201                 ; ***statistic***
     rl  w2  x1+p209   ;
     al  w2  x2+1      ; no of retransmit1:=
     rs  w2  x1+p209   ; no of retransmit1 + 1;
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time
     al. w2  r0.       ;
z.                     ; ***statistic***
     jl.     m1.       ;   goto transmit-receive;


; send nak.
; inserts a negative acknowledge in standard out area, transmits the block and
; starts a receive operation.
q7:  al  w3  0         ; sendnak:
c.p201                 ; ***statistic***
     rl  w3  x1+p210   ;
     al  w3  x3+1      ; no of nak:=
     rs  w3  x1+p210   ; no of nak + 1
     al  w3  0         ;
z.                     ;
     rs  w3  x1+p46    ;   clear timer0, timer1;
     al  w3  1         ;
     ba  w3  x1+p45    ;   clear count0;
     rs  w3  x1+p44    ;   count1:=count1+1;
     sl  w3  p145      ;   if count1>=maxcount1 then
     jl.     q0.       ;     goto master clear;
     bz  w3  x1+p43    ;
     sz  w3  2.1       ;
     am      2.0010000 ;
     al  w0  2.1000000 ;   work:=(ack on+nak+ackrec mod 2)<4;
     ls  w0  8         ;
     jl.     j1.       ;   goto setup;


; send header.
; updates the trm ackcounter, sets the blockcontrol and preceeds to sendack.
q8:  al  w3  1         ;
c.p201                 ; ***statistic***
     rl  w3  x1+p211   ;
     al  w3  x3+1      ;
     rs  w3  x1+p211   ; increase no of headers
     al  w3  1         ;
    z.                 ; ***statistic***
     ba  w3  x1+p42    ;   acktr:=acktr+1;
     hs  w3  x1+p42    ;
     bz  w3  x1+p61    ;
     sz  w3  2.1       ;   if func(header) implies datablock then
     am      2.01<8    ;     blockcontrol:=2.11
     al  w0  2.10<8    ;   else blockcontrol:=2.10;
     dl  w3  x1+p50+2  ; get packed control word
     ld  w3  -8        ;
     lo  w0  6         ;
     jl.     j0.       ;

; send ack.
; packs the control field, inserts it in the standard out area and transmits the block.
q9:  al  w0  0         ; send ack: if no header then
c.p201                 ; ***statistic***
     rl  w0  x1+p212   ;
     ba. w0  1         ; no of ack:=
     rs  w0  x1+p212   ; no of ack + 1
     al  w0  0         ;
z.                     ; ***statistic***
j0:  al  w3  0         ;     blockcontrol:=2.00,type:=ack/header;
     rs  w3  x1+p44    ;   clear count0, count1;
     rs  w3  x1+p46    ;   clear timer0, timer1;
     al  w3  1         ;
     ba  w3  x1+p43    ;   ackrec:=acrec+1;
     hs  w3  x1+p43    ;
     sz  w3  2.1       ;
     am      2.00100   ;   work:=(ack on+ack+ackrec mod 2)<2+control;
     al  w3  2.11000   ;
     ba  w3  x1+p41    ;
     ls  w3  2+8       ;   work:=(work<2)<8;
     lo  w0  6         ;   work:=work or blockcontrol;
j1:  la. w0  i0.       ; setup: mask control
     dl  w3  x1+p50+2  ; get std out(+0,+2)
     ld  w3  -8        ;
     la. w3  i1.       ; mask off comtrol
     lo  w3  0         ; add control
     ld  w3  8         ;
     rs  w2  x1+p50    ; store unchanged size shift 8 + 2 msb of control
     ls  w3  -12       ;
     hs  w3  x1+p50+2  ; store 8 lsb of control + 4 unchanged bits
     al  w2  x1+p50    ;
     al  w3  x1+p51    ;   out area:=
     ds  w3  x1+p2+p23 ;     std out area;
     rl. w3  r3.       ;
     rs  w3  x1+p2+p20 ;   headchar,count:=<soh>,std;
     al  w2  x1+p2     ;
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time
     al  w2  x1+p2     ;
z.                     ; ***statistic***
     jl.     m1.       ;   goto transmit-receive;


; send data.
; initiates the transfer of the datablock defined in the transmit parameters.
q10: al  w3  0         ; send data:
     rs  w3  x1+p44    ;   clear count0, count1;
     rs  w3  x1+p46    ;   clear timer0, timer1;
     al  w3  1         ;
     ba  w3  x1+p42    ;   acktr:=acktr+1;
     hs  w3  x1+p42    ;
     dl  w0  x1+p66    ;
     ds  w0  x1+p2+p23 ;   out area:=data trm area;
     rl. w0  r5.       ;
     hl  w0  x1+p67    ;   headchar,count:=<stx>,count out;
     rs  w0  x1+p2+p20 ;
     al  w2  x1+p2     ;
c.p201                 ; ***statistic***
     rl  w0  x1+p213   ;
     ba. w0  1         ;
     rs  w0  x1+p213   ; increase no of datablocks send
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time
     al  w2  x1+p2     ;
z.                     ; ***statistic***
     jl.     m1.       ;   got transmit-receive;


; send request for line.
; sets up a request for line using the internal block description.
q11: rl. w2  r3.       ; sendreq:
     rs. w2  r0.       ;   headchar, count out:=<soh>, 0;
     rl  w2  x1+p2+p25 ;
     rs. w2  r0.+p25   ;   devno:=devno(trm);
c.p101  b.f1 w.
     rs. w3  f0.       ; start test 17
     jl. w3  f4.       ;
     17                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w2  x3        ;
     rl  w0  x1+p30    ;
     rs  w0  x2        ;
     dl  w0  x1+p32    ;
     ds  w0  x2+4      ;
     al  w0  x2        ;
     al  w1  x2+4      ;
     jl. w3  f5.       ;
f1:                    ; end test 17
e.z.
     al  w0  0         ;
     rs  w0  x1+p31    ;   first waiting:=0;
     al  w0  1         ;
     rs  w0  x1+p30    ;   request:=1;
     al. w2  r0.       ;   block out desc:=internal block desc;
c.p201                 ; ***statistic***
     rl  w0  x1+p214   ;
     ba. w0  1         ; no of req for line send:=
     rs  w0  x1+p214   ; no of req for line send + 1
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time

     al. w2  r0.       ;
z.                     ; ***statistic***
     jl.     m3.       ; exit: goto transmit;


; send answer master clear.
q12: rl. w0  r8.       ; control:=answ master clear, pos ack on block 1, accept, header
                       ; retrm:=0, loc function:=2  (HOST identifying itself)
     al  w3  1         ;
     ba  w3  x1+p42    ;
     hs  w3  x1+p42    ;
     al  w3  0         ; size:=0
     ld  w0  8         ; format(packet):=0
     ds  w0  x1+p50+2  ; priority:=0
     al  w3  0         ;
     rl  w0  x1+p11    ; rec net-id:=0
     ld  w0  16        ; rec home reg, rec host id:= main.p11
     ds  w0  x1+p50+6  ;
     
     al  w2  x1+p50    ; out area:=
     al  w3  x1+p51    ;      std out area
     ds  w3  x1+p2+p23 ;
             
     rl. w3  r3.       ; headerchar,count:=<soh>,std
     rs  w3  x1+p2+p20 ;
     al  w2  x1+p2     ;
c.p201                 ; ***statistic***
     rl  w0  x1+p244   ;
     ba. w0  1         ;
     rs  w0  x1+p244   ; increase no of m cl received
     jl. w3  n9.       ;
     ds  w3  x1+p220   ; set m-call time
     al  w2  x1+p2     ;
z.                     ; ***statistic***
     jl.     m1.       ; goto transmit-receive;
       
i0:  8.777400          ; mask control
i1:  8.77000377        ; mask control off
                       ;   goto setup;

e.

; stepping stone.
     jl.     n9.       ;
n9=k-2                 ;


;*p7*

; communication block.
; in this block the <state> means: <block transmitted>.<block received>
; this block monitors the communication on the channel.
b.i20,j20 w.

; state: -.master clear
t0:                    ; ok0:
c.p201                 ;*****statistics*****
     jl. w3  n9.       ;
     ds  w3  x1+p222   ; set t0-entry time
                       ; current t-entry unchanged
z.                     ; ***statistic***
     jl. w3  n14.      ;
     al  w0  p160      ;   clear subprocs;
     hs  w0  x1+p41    ;   control(out):=ok;
     al  w0  1         ;
     rs  w0  x1+p43    ; acktr:=0, ackrec:=1
     al  w0  12        ;
     hs  w0  x1+p40    ;   expstate:=ack-header.ack in master clear sequense;
c.p201 b. f1 w.        ; *** test 9 ***
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     9
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ; no parameters
     jl. w3  f5.       ;
     rl  w0  x1+p244   ; if no of masterclears<>0
     se  w0  0         ;
     jl. w3  f6.       ;  then stop testoutput
f1:                    ;
e.z.                   ; *** end of test 9 ***
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p221   ;
z.                     ; ***statistic***
     jl.     q12.      ;   goto send answer master clear;

; state: ack.header
t1:                    ; ok1:
c.p201                 ;*****statistics*****
     jl. w3  n9.       ;
     ds  w3  x1+p223   ; set t1-entry time
     rl  w2  x1+p235   ;
     sn  w2  0         ;
     al  w2  1         ;
     rs  w2  x1+p235   ; curr t-entry:= if tn then tn else t1
z.                     ; ***statistic***
     bz  w0  x1+p39    ;
     se  w0  p130      ;
     jl.     j0.       ;
     jl. w3  n10.      ;   unpack header;
     bz  w0  x1+p99    ;
     sn  w0  0         ;
     jl.     j20.      ;
     se  w0  3         ;
     jl.     j1.       ;
j20:                   ;
     rs  w0  x1+p31    ;   first waiting:=0;
     bl  w0  x1+p81    ;
     al  w2  x1+p100-a48;  load hostproc;
     sh  w0  v40-1     ;   if func>=min subproc value func then
     rs  w2  x1+p90    ;     proc:=subproc;
     rl  w2  x1+p90    ;   else proc:=hostproc;
     se  w1 (x2+a50)   ;   if mainproc(proc)<>mainproc then
     jl.     j10.      ;     goto error0;
     so  w0  2.1       ;   if no datablock then
     jl.     t2.       ;     goto ok2;
     jl. w3  e3.       ;   call entry3(proc);
     bl  w0  x1+p80    ;
     hs  w0  x1+p41    ;   control(out):=internal status;
     se  w0  p160      ;   if internal status(rec)<>ok then
     jl.     j3.       ;     goto nextproc;
     al  w0  4         ;
     hs  w0  x1+p40    ;   expstate:=ack.data;
     dl  w0  x1+p86    ;
     ds  w0  x1+p3+p23 ;   first,last out:=first,last data rec;
     bz  w0  x1+p87    ;
     hs  w0  x1+p3+p21 ;   count out:=count data trm;
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p221   ; set q-call time
z.                     ; ***statistic***
     jl.     q9.       ;   goto sendack;

j1:  se  w0  1         ; specfunc:
     jl.     j2.       ;   if local function=host-down then
     rl  w0  x1+p93    ;     host-id:=host-id(sender);
     bz  w2  x1+p91    ;     net-id:=net-id(sender);
     jl. w3  n15.      ;     clear subprocesses(host-id,main,net-id);
     jl.     j2.       ;   goto sendok;

j0:  se  w0  p131      ; poll: if type<>poll then
     jl.     2         ;     goto xx;
j2:  al  w0  p160      ; sendok:
     hs  w0  x1+p41    ;   control(out):=ok;
c.p201                 ; ***statistic***
     rl  w0  x1+p215   ;
     ba. w0  1         ;
     rs  w0  x1+p215   ; increase no of gen poll
z.                     ; ***statistic***
     jl.     j3.       ;   goto nextproc;

; state: ack.data
t2: c.p201             ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p224   ; set t2-entry time
     rl  w2  x1+p235   ;
     se  w2  1         ; if current t-entry <> 1
     al  w2  2         ;  then
     rs  w2  x1+p235   ;    current t-entry:=2
                       ;
z.                     ; ***statistic***
     rl  w2  x1+p90    ; ok2:
     jl. w3  e4.       ;   call entry4(proc);
     bl  w0  x1+p80    ;
     hs  w0  x1+p41    ;   control(out):=internal status(rec);
     al  w2  x1+p52    ;
     al  w3  x1+p53    ;
     ds  w3  x1+p3+p23 ;   in area:=std in area;
     rl. w3  r3.       ;
     rs  w3  x1+p3+p20 ;
                       ;   goto nextproc;

j3:  rl  w3  x1+p14    ; nextproc:
     al  w2  x3-p14    ;   sub:=next sub in proc queue;
     se  w3  x1+p14    ;   if event queue empty
     sn  w2 (x1+p31)   ;   or sub=first waiting then
     jl.     j4.       ;     goto nooperation;
     rs  w2  x1+p70    ;   proc(trm):=sub;
     ld  w0  -100      ;
     ds  w0  x1+p62    ;
     ds  w0  x1+p64    ; clear trm-parameters
     ds  w0  x1+p66    ;
     ds  w0  x1+p69    ;
     ds  w0  x1+p73    ;
     jl. w3  e1.       ;   call entry1(proc);
     bz  w0  x1+p60    ;
     se  w0  p160      ;   if internal status(trm)<>ok then
     jl.     j6.       ;     goto regretted;
     jl. w3  n11.      ;   packin(header);
     jl.     j5.       ;    error: goto param-error;
     al  w0  6         ;
     hs  w0  x1+p40    ;   expstate:=ack-header.ack;
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p221   ; set g-call time
z.                     ; ***statistic***
     jl.     q8.       ;   goto sendheader;

j4:  al  w0  2         ; nooperation:
     hs  w0  x1+p40    ;   state := ack.header;
     jl.     q9.       ;   goto sendack;

j5:                    ; param-error:
c.p101  b.f1 w.        ;*****test15*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     15                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p60    ;
     al  w1  x1+p70    ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test15*****
j6:  jl. w3  n12.      ; regretted: queue out(sub);
     jl.     j3.       ;   goto nextproc;

; state: ack-header.ack
t3:                    ; ok3:
c.p201                 ;*****statistics*****
     jl. w3  n9.       ;
     ds  w3  x1+p225   ; set t3-entry time
     al  w2  3         ;
     rs  w2  x1+p235   ;
z.                     ; ***statistic***
     bz  w3  x1+p61    ;
     bz  w0  x1+p41    ;
     sn  w0  p160      ;   if control(out)<>ok
     so  w3  2.1       ;   or no datas ready then
     jl.     j11.      ;     goto error1;
     al  w0  8         ;
     hs  w0  x1+p40    ;   expstate:=data.ack;
c.p201                 ; ***statistic***

     jl. w3  n9.       ;
     ds  w3  x1+p221   ;
z.                     ; ***statistic***
     jl.     q10.      ;   goto senddata;

; state: header.ack
; only used when the transmitted header is master clear.
t4:  jl.     j14.      ; ok4: goto error4;
         
; state: header.ack-header in master clear sequence
; last send was an answer master clear header containing ack for
; master clear. as 3600 always sends terminating ack in a header
; of type gen poll ( in order to ensure that an idle situation
; is a situation in which 3600 is master ) this is the block normally 
; received. but if 3600 has somthing to send it may send ack for answer master clear
; answer master clear in a normal header.
; in case of ack in gen poll the routine switch to next process
; whereas a normal header transfer control to ok1.
t15: c.p201            ; ***statistic
     jl. w3  n9.       ;
     ds  w3  x1+p231   ;
     al  w2  9         ;
     rs  w2  x1+p235   ;
z.                     ; ***statistic***
              
     bz  w0  x1+p39    ; if type(control)=gen poll
     sn  w0  2.001     ;    then
     jl.     j3.       ;          goto nextproc
      
     bz  w0  x1+p41    ;    else
     sn  w0  p160      ;         if control(in)=ok
     jl.     t1.       ;            then goto ok1;

c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p221   ; set q-call time
z.                     ; ***statistic***
     jl.     q0.       ;            else goto send master clear;
        

; state: ack-header.ack-header
t5:                    ; ok5:
c.p201                 ;*****statistics*****
     jl. w3  n9.       ;

     ds  w3  x1+p227   ; set t5-entry time
     al  w2  5         ;
     rs  w2  x1+p235   ; curr t-entry:=5
z.                     ; ***statistic***
     bz  w3  x1+p61    ;
     bz  w0  x1+p41    ;
     sn  w0  p160      ;   if control(out)<>ok
     so  w3  2.1       ;   or no datas ready then
     jl.     j7.       ;     goto check;
     jl.     j13.      ;   goto error3;

; state: header.ack-header
; only used when the transmitted header is master clear.
t6:                    ; ok6:
c.p201                 ;*****statistics*****
     jl. w3  n9.       ;
     ds  w3  x1+p228   ;
     al  w2  6         ;
     rs  w2  x1+p235   ;
z.                     ; ***statistic***
     bz  w0  x1+p41    ;
     sn  w0  p160      ;   if control(in)=ok then
     jl.     t1.       ;     goto ok1;
c.p201                 ; ***statistic***
     jl. w3  n9.       ;
     ds  w3  x1+p221   ; set q-call time
z.                     ; ***statistic***
     jl.     q0.       ;   goto send master clear;

; state: data.ack
t7:  jl.     j12.      ; ok7: goto error2;

; state: data.ack-header
t8:                    ; ok8:
c.p201                 ;*****statistics*****
     jl. w3  n9.       ;
     ds  w3  x1+p230   ; set t8-entry time
     rl  w2  x1+p235   ;
     sn  w2  0         ; 
     al  w2  8         ;
     rs  w2  x1+p235   ;
z.                     ; ***statistic***
     bz  w0  x1+p41    ;
j7:  hs  w0  x1+p60    ; check: internal status(trm):=control(in);
     rl  w2  x1+p70    ;
     al  w3  0         ;
     se  w0  p161      ;   if control<>wait then
     jl.     j8.       ;     first waiting:=0;
     rl  w3  x1+p31    ;   else
     sn  w3  0         ;     if first waiting=0 then
     al  w3  x2        ;       first waiting:=sub;
j8:  rs  w3  x1+p31    ;
     jl. w3  n12.      ;   queue out(sub);
     jl. w3  e2.       ;   call entry2(sub);
     jl.     t1.       ;   goto ok1;

; give up.
; expstate ..
t11:                   ; give up:
c.p101 b.f1 w.         ;*****test7*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     7                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p11    ;
     al  w1  x1+p100-2 ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test7*****
     jl. w3  n14.      ;   clear all subprocesses(main);
     jl. w3  n13.      ;   initiate processs description;
     al  w0  10        ;
     hs  w0  x1+p40    ;   expstate:=10;
     jl.     q0.       ;   goto send master clear;

; errors.
j10:                   ; error0:
c.p101 b.f1 w.         ;*****test16*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     16                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x2        ;   dump proc desc
     al  w1  x2+a79    ;     of erroneous process;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test16*****
     al  w0  p162      ;   control(out):=skip;
     hs  w0  x1+p41    ;
     jl.     j3.       ;   goto nextproc;

j11: am      1-2       ; error1:
j12: am      2-3       ; error2:
j13: am      3-4       ; error3:
j14: al  w0  4         ; error4:
     hs  w0  x1+p38    ;
c.p101  b.f1 w.
     rs. w3  f0.       ; start test 6
     jl. w3  f4.       ;
     6                 ;
f0:  0                 ;
     jl.     f1.       ;
     rl  w1  b19       ;
     al  w0  x1        ;
     al  w1  x1+p100   ;
     jl. w3  f5.       ;
f1:                    ; end test 6
e.z.
     jl.     q6.       ;   goto sendenq;

;after interrupt.
; w1: mainproc, w2: 0 , w3: state
t12:                   ; ok12:
c.p201                 ;*****statistics*****
     al  w0  x3
     jl. w3  n9.       ;
     ds  w3  x1+p234   ; set t12 entry time
     ds  w3  x1+p220   ;
     ds  w3  x1+p221   ; set  q-call time
     al  w2  12        ;
     rs  w2  x1+p235   ; cur entry:=12
     rl   w3  0

     al  w2  0
z.                     ; ***statistic***
     jl.    (x3+2)     ;
     t0                ; 0
     m4                ; 2
     m6                ; 4
     m6                ; 6
     m6                ; 8
     m6                ; 10
     m6                ; 12
     m6                ; 14
     m6                ; 16
e.

;*p8*

; communication with subdrivers.
; each subdriver has six entry points with the functions:
;
; entry0 (deliver message):
;   used when send message delivers a message to the subexternal process.
;
; entry1 (set up oeration):
;   used when the mainproc wants the subdriver to start an operation.
;
; entry2 (end transfer):
;   used when the operation - and the datablock - has been sent, and
;   the receipt received.
;
; entry3 (receive operation):
;   used when a header that includes a following datablock is received.
;
; entry4 (end receive):
;   used when the receive operations are finished.
;
; entry5 (initiate process):
;   used after creation of the subprocess.
;
; contence of registers entering the subprocess:
;   w0: , w1: subproc , w2: , w3: .
;  current process (b19) : subprocess.
; 
; standard return from the subprocess is:
;   jl    (b101)
;  w0-w3 undefined.
; return with initiation is:
;   am    (b101)
;   jl     -2
;  with w2: process description addr of the subprocess which shall be initiated.
;
; the adresses of the different entry points are defined in a table at
; top of the subprocess drivers:
;  h-name(driver start addr): addr(entry0)
;                             addr(entry1)
;                             ....
;
;        call:         return:
; w0                   destroyed
; w1                   mainproc
; w2     subproc       destroyed
; w3     link          destroyed

b.i10,j10 w.
e0:  am      0-2       ; call(entry0):
e1:  am      2-4       ; call(entry1):
e2:  am      4-6       ; call(entry2):
e3:  am      6-8       ; call(entry3):
e4:  am      8-10      ; call(entry4):
e5:  al  w0  10        ; call(entry5):
     se  w0  10        ;   if entry<>entry 5 then
     rs. w3  i0.       ;     return addr:=link;
     rs  w2  b19       ;   current proc:=subproc;
     bl  w3  x2+p10    ;
c.p101  b.f1 w.
     rs. w0  i10.      ;
     rs. w3  f0.       ; start test 1
     jl. w3  f4.       ;
     1                 ;
f0:  0                 ;
     jl.     f1.       ;
     rs  w0  x3        ;
     rs  w1  x3+2      ;
     rs  w2  x3+4      ;
     rl. w0  f0.       ;
     rs  w0  x3+6      ;
     al  w0  x3        ;
     al  w1  x3+6      ;
     jl. w3  f5.       ;
f1:                    ; end test 1
e.z.
     al  w1  x2        ;
     rl  w2  0         ;
     am.    (x3+j0.)   ;
     jl     (x2)       ;

     h99               ; -2: hostprocess
j0:  h100              ;  0: general sequential device
     h102              ;  2: clock
     h104              ;  4: bs-area
     h106              ;  6: disc
     h108              ;  8: terminal
     h110              ; 10: reader
     h112              ; 12: punch
     h114              ; 14: printer
     h116              ; 16: cardreader
     h118              ; 18: magtape
     h120              ; 20: plotter
     h122              ; 22: discette



; return points from the subprocesses.

     jl.     e5.       ; return(init): (w2: subproc(init)) goto entry 5;
h98: rl  w2  b19       ; return(std):
     rl  w1  x2+a50    ;
     rs  w1  b19       ;   cur proc:=mainproc;
c.p101  b.f1,j10 w.
     rs. w3  f0.       ; start test 2
     jl. w3  f4.       ;
     2                 ;
f0:  0                 ;
     jl.     f1.       ;
     rl. w2  i10.      ;
     jl.    (x2+2)     ;
     j0                ; 0
     j1                ; 1
     j2                ; 2
     j3                ; 3
     j3                ; 4
     j3                ; 5
j0:  al  w0  x1+2      ;
     jl.     j6.       ;
j1:  al  w0  x1+p60    ;
     al  w1  x1+p70    ;
     jl.     j6.       ;
j2:  al  w0  x1+p60    ;
     al  w1  x1+p60    ;
     jl.     j6.       ;
j3:  al  w0  x1+p80    ;
     al  w1  x1+p90    ;
j6:  jl. w3  f5.       ;
f1:                    ; end test 2
e.z.
     jl.    (i0.)      ; exit: return to link;

i0:  0                 ; return addr(subproc)
i10: 0                 ; saved entry no

a66=j0

e.


; dummy subprocess.

b.q5,i0 w.
i0:   q0                ; addr(entry 0)
     q1                ; addr(entry 1)
     q2                ; addr(entry 2)
     q3                ; addr(entry 3)
     q4                ; addr(entry 4)
     q5                ; addr(entry 5)

q0:  jl      g3        ; entry 0: goto result 5;

q1:  al  w0  p163      ; entry 1:
     am     (x1+a50)   ;
     hs  w0  +p60      ;   internal status:=reject;
q2:  jl     (b101)     ; entry 2: return(std);

q3:  al  w0  p163      ; entry 3:
     am     (x1+a50)   ;
     hs  w0  +p80      ;   internal status:=reject;
q4:                    ; entry 4:
q5:  jl     (b101)     ; entry 5: return(std);

h102=i0 ,  h104=i0
e.
 



;*p9*

; subkind driver.
; all messages to subprocesses passes through this block.
b.j10 w.
h34:                  ; hostprocess:
h35: al  w2  x3       ; subprocess:
     rl  w1  x2+a50   ;   main:=mainproc(sub);
     sn  w1  0         ;   if main(sub)=0 then
     jl      g4        ;     goto result 4;
     rl  w0  x1+p14   ;
     sn  w0  x1+p14   ;   if proc queue(main) is empty then
     jl.     j0.      ;     goto test request;
     rl  w3  x1+p31    ;
     se  w3  0         ;   if first waiting<>0 then
     jl.     j0.       ;     goto test request;
     jl. w3  e0.      ;   call entry0(sub);
     jl     (b20)     ;   return to program;
j0: c.p201             ;  *** statistic ***
     rs  w2  x1+p236   ;  save w2
     jl. w3  n9.       ;  get time
     ds  w3  x1+p242   ; req_call_time := get time
     rl  w0  x1+p217   ;  if wait2=0 comment req arrived
     se  w0  0         ;             while main in wait1;
     jl.     j1.       ;  then
     ss  w3  x1+p216   ;    begin
     ds  w3  x1+p240   ;      wait1_before_req:= now time - wait1;
     dl  w3  x1+p216   ;
     ss  w3  x1+p220   ;
     ds  w3  x1+p239   ;      m_code_time:= wait1 - m_call_time;
     jl.     j2.       ;    end
j1:                    ;  else       comment req arrived;
     ss  w3  x1+p217   ;    begin    while main in wait2;
     ds  w3  x1+p241   ;      wait2_before_req:= now time - wait2;
     dl  w3  x1+p216   ;
     ds  w3  x1+p240   ;      wait1_before_request:= wait1;
     dl  w3  x1+p217   ;
     ss  w3  x1+p220   ;
     ss  w3  x1+p216   ;
     ds  w3  x1+p239   ;      m_code_time:= wait2 - m_call_time - wait1;
                       ;    end;
j2:  ld  w3  -100      ;
     ds  w3  x1+p216   ;
     ds  w3  x1+p217   ;
     dl  w3  x1+p221   ;
     rl  w0  x1+p235   ;
     ls  w0  2         ;
     am      (0)       ;

     ss  w3  x1+p222   ;
     ds  w3  x1+p237   ; t_code_time:= q_call_time - t.curr-entry-time;
     dl  w3  x1+p220   ;
     ss  w3  x1+p221   ;
     ds  w3  x1+p238   ; q_code_time:= m_call_time - q_call_time;
     al  w2  1         ;
     rs  w2  x1+p226   ;
     rl  w2  x1+p236   ; reestablish w2
z.                     ;  *** statistic ***
     jl. w3  e0.      ; test request:
     rl  w0  x1+p14   ;   call entry0(sub);
     bz  w2  x1+p40   ;
     se  w0  x1+p14   ;   if proc queue(main) is empty 
     se  w2  2         ;   or expstate<>2 then
     jl     (b20)     ;     return to program;
c.p201                 ;  *** statistic ***
     jl. w3  n9.       ;   get time
     ds  w3  x1+p221   ;   q_call_time:= get time;
z.                     ;  *** statistic  ***
     jl.     q11.     ;   goto send req;
e.

e.   ; end of mainprocess driver (e,m,n,q,r,s and t-names).

c.p101

; stepping stones.
     jl.     f4.       ;
f4=k-2
     jl.     f5.       ;
f5=k-2
     jl.     f6.       ;
f6=k-2

z.



; block containing host - and subprocess drivers.

b.u100 w.

c.-p103
p301=p71
p302=p72
p303=p73
p321=p91
p322=p92
p323=p93
z.

; block containing host and subhost drivers.

b.s120 w.

; host process.

b.i10,j10 w.

; format of the process description:

m.          host


; a48:                 ; <interval>
; a49:                 ; <interval>
; a10:                 ; <kind>=90
; a11:                 ; <name>=<:host:>
; a50:                 ; <dummy>
; a52:                 ; <dummy>
; a53:                 ; <dummy>
; a54:                 ; <next message>
; a55:                 ; <last message>
; a56:                 ; <dummy>


; format of message and answer:

s0=8      , s1=s0+1    ; operation  , mode
s2=s0+2                ; first addr(buffer)
s3=s2+2                ; last addr(buffer)
s4=s3+2   , s5=s4+1    ; dh.linkno  , hostno
s6=s4+2                ; dh.host-id
s7=s6+2   , s8=s7+1    ; dh.home-reg, dh.net-id
s9=s7+2                ; jh.host-id
s10=s9+2  , s11=s10+1  ; jh.linkno  , jh.net-id

s31=22                 ; size of datas used in connection with operation=1

; the host-driver accepts the following operations and modes:

;  operation  mode     header function
;      1      5             9         lookup process
;      1      6,7          13         lookup
;      1      8,9          17         lookup reserve
;      1      10,21        11         cancel reservation
;      1      12,13        25         linkup remote
;      1      14,15        29         linkup local
;      1      16,17        32         lookup link
;      2      0,1           8         release link
;      9      0,1,2,3      45         operator output
;     11      0,1,2,3      41         operator output-input
;                           2         create
;                           6         remove
;     16      0,2         128         setstate


a0=1<23
i0:  a0>0+a0>1+a0>2+a0>9+a0>11+a0>16
i1:  a0>5+a0>6+a0>7+a0>8+a0>9+a0>10+a0>11+a0>12+a0>13+a0>14+a0>15+a0>16+a0>17
i2:  a0>0+a0>1
i3:  a0>0+a0>1+a0>2+a0>3
i4:  a0>0+a0>2

h90: bz  w0  x2+s0     ; host process:
     rl. w1  i1.       ;
     sn  w0  2         ;   mode mask:=mode mask(operation);
     rl. w1  i2.       ;
     sl  w0  3         ;
     rl. w1  i3.       ;
     sn  w0  16        ;
     rl. w1  i4.       ;
     rl. w0  i0.       ;
     jl  w3  g16       ;   check operation(operation mask, mode mask);

; check host-addr.
     rl  w0  x2+s1     ;
     so  w0  2.1       ;   if address mode=1 then
     jl.     j1.       ;    begin
     la  w0  g50       ;     address mode:=0;
     rs  w0  x2+s1     ;
     rl  w3  x2+s4     ;     sub:=proc desc addr(mess);
     rl  w1  b4        ;
     al  w1  x1-2      ;
j0:  al  w1  x1+2      ;   if sub is not included in device part of nametable then
     sl  w1 (b5)       ;     goto result 3;
     jl      g5        ;
     se  w3 (x1)       ;
     jl.     j0.       ;
     rl  w0  x3+a10    ;
     la  w0  g50       ;
     se  w0  p112      ;   if kind(sub)<>local or remote process then
     jl      g5        ;     goto result3;
     rl  w0  x3+a50    ;   if main(sub)=0 then
     sn  w0  0         ;     goto free sub;
     jl.     j4.       ;
     bz  w0  x3+p11    ;
     hs  w0  x2+s4     ;     dh.linkno:=dh.linkno(sub);
     rl  w0  x3+p5     ;
     rs  w0  x2+s6     ;     dh.host-id:=dh.host-id(sub);
     bz  w0  x3+p6     ;
     hs  w0  x2+s7     ;     dh.home-reg:=dh.home-reg(sub);
     bz  w0  x3+p7     ;
     hs  w0  x2+s8     ;     dh.net-id:=dh.net-id(sub);
     bz  w0  x3+p9     ;
     hs  w0  x2+s10    ;     jh.linkno:=jh.linkno(sub);
     rl  w1  x3+a50    ;
     rl  w0  x1+p202+p5;
     rs  w0  x2+s9     ;     jh.host-id:=jh.host-id(subhost);
     bz  w0  x1+p202+p7;
     hs  w0  x2+s11    ;     jh.net-id:=jh.net-id(sender host);
     bz  w0  x1+p202+p9;
     hs  w0  x2+s5     ;     hostno:=rcno(subhost(main(sub)));
                       ;    end;

; this block transfers the operation and mode of the message
; into a function mode of the format:
;    fmode:=header function<2+header mode.
j1:  bz  w0  x2+s0     ;
     se  w0  1         ;   if operation=1 then
     jl.     j2.       ;    begin
     bz  w3  x2+s1     ;     if mode(mess)<>32 then
     ls  w3  1         ;
     se  w3  32        ;       header function:=(mode(mess)+1)<1;
     al  w3  x3+1      ;     else
     ls  w3  2         ;       header function:=mode(mess)<1;
     rl  w0  x2+s3     ;
     ws  w0  x2+s2     ;   if size(data)<std data buffer size then
     sh  w0  s31-2-1   ;     goto result 3;
     jl      g5        ;    end;
     jl.     j3.       ;
j2:  al  w3  8<2       ;   if operation=2 then
     sn  w0  2         ;     header function:=8;
     jl.     j3.       ;
     sn  w0  9         ;   if operation=9 then
     al  w3  45<2      ;     header function:=45;
     sn  w0  11        ;   if operation=11 then
     al  w3  41<2      ;     header function:=41;
     sn  w0  16        ;   if operation=16 then
     al  w3  128<2     ;     header function:=128;
     bz  w0  x2+s1     ;
     se  w0  0         ;   if mode<>0 then
     al  w3  x3+1      ;     header mode:=1;
j3:  hs  w3  x2+s1     ;

; call subhost.
     bz  w3  x2+s5     ;   subhost:=
     ls  w3  1         ;     word(hostno<1+start(name table));
     wa  w3  b4        ;
     sl  w3 (b5)       ;   if host process outside name table then
     jl      g5        ;     goto result3;
     rl  w3  x3        ;
     rl  w0  x3+a10    ;
     se  w0  p111      ;   if kind(subhost)<>subhost kind then
     jl      g5        ;     goto result 3;
     rs  w3  b19       ;   current process:=subhost;
c.-p103
     jl.     h34.      ;   goto subhost-driver;
z.
c.p103-1
     jl.     h82.      ;   goto subhost-driver;
z.

j4:  rl  w0  x2+s0     ; free sub:
     se. w0 (i10.)     ;   if operation<>lookup process then
     jl      g5        ;     goto result3;
     ld  w0  -100      ;
c.-p103
     rs  w0  x2+8      ;   status:=0
     ds  w0  x2+12     ;   bytes, chars trf:= 0,0;
z.
c.p103-1
     rs  w0  g20       ;
     ds  w0  g22       ;   status, bytes trf:=0,0;
z.
     jl      g7        ;   goto result1;

i10: 1<12+2<1          ;

e.                     ; end host process.

; subhost process.

; block including the host-process driver.

b.n130,q10,r40,t10 w.

m.                subhost

; a48:                 ; <interval>
; a49:                 ; <interval>
; a10:                 ; <kind>
; a11:                 ; <name>
; a50:                 ; <mainproc>
; a52:                 ; <reserver>
; a53:                 ; <users>
; a54:                 ; <next message>
; a55:                 ; <last message>
; a56:                 ; <external state>

; p0: start of specific part:
s40=p0                 ; mess buffer
s41=s40+2              ; state (0: closed, 1: open)
; p1: top of specific part;

; p11: , p9 :          ; <devno> , <rcno>
; p10: , p8 :          ; <subkind=-2> , <various>
; p12:                 ; <state>
; p14:                 ; <next subproc>
; p15:                 ; <last subproc>
; p16: , p17:          ; <buffers free> , <current bufno>
; p18:                 ; <max bufsize=24>
; p7 : , p6 :          ; <net-id(subhost)> , <home reg(subhost)>
; p5 :                 ; <host-id(subhost)>
; p13:                 ; <current message>
; p19:                 ; start(mess buf table):         
;  p19+v3<1            ; top(mess buf table).

s100=p19+v3<1          ; start of output buffer:
s101=20                ;   size of output buffer
s102=s100+s101         ; start of input buffer:
s103=s101              ;   size of input buffer



h99: q0                ; deliver message
     q1                ; transfer operation
     q2                ; end transfer
     q3                ; receive operation
     q4                ; end receive
;    q5                ; initiate process


; answers to create and remove operations are stored in a message buffer
; (claims are borrowed from the subprocess). the message buffers are queued
; up in the event queue until the answer can be transmitted.
; format of the save-buffer:
s16=8     , s17=s16+1  ;  -1          , header function<2
s18=s16+2 , s19=s18+1  ;  dh.linkno   , jh.linkno
s20=s18+2 , s21=s20+1  ;  bufno       , result
s22=s20+2 , s23=s22+1  ;  unused      , quality mask
s24=s22+2 , s25=s24+1  ;  jh.net-id   , jh.home-reg
s26=s24+2              ;  jh.host-id
s28=s26+2 , s29=s28+1  ;  state       , unused
s30=s28+2              ;  mode


r0:                    ; internal output buffer.
h. r1:  0 ,  r2:  0    ;   mode      , kind
   r3:  0 ,  r4:  0    ;   timeout   , buffers
w. r5:  0              ;   buffersize
   r6:  0 , r.4        ;   devicename
   r7:  0              ;   jh. linkno
   r8:  0              ;   jh. host-id
h. r9:  0 , r10: 0     ;   jh. home-reg, jh. net-id
w. r11: 0              ;   proc desc

r20:                   ; internal input buffer.
   r22: 0              ;   kind
   r24: 0              ;   max. buffers
   r25: 0              ;   max. buffersize
   r26: 0 , r.4        ;   devicename
   r27: 0              ;   jh. linkno
   r28: 0              ;   jh. host-id
h. r29: 0 , r30: 0     ;   jh. home-reg, jh. net-id
w. r31: 0              ;   process description

   r32: 0              ;   dh. linkno

; entry0.

b.i10,j10 w.

q0:                    ; entry0:
     rl  w2  b18       ;
     rl  w1  b1        ;
     jl  w3  g14       ;   check user;
     rl  w1  b19       ;
c.p101 b.f1 w.         ;*****test72*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     72                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x2+8      ;   dump contents of mess buffer
     al  w1  x2+22     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test72*****
     bz  w0  x2+s1     ;
     sn  w0  9<2       ;   if fmode=9<2 then
     jl.     j0.       ;     goto lookup-process;
     se  w0  128<2     ;
     sn  w0  128<2+1   ;   if header function=128 then
     jl.     j5.       ;     goto setstate;
     jl. w3  n20.      ;   link operation;
     jl. w3  n21.      ;   testready and link;
     jl     (b101)     ; exit0: return to main;

; lookup process.
; lookup process delivers an answer equal to the one described in xxx and
; an input data buffer of the format-
;
;    +0  kind
;    +2  buffers
;    +4  max. buffersize
;    +6  name of the external process
;    +14 jh. linkno(=logical devicenumber)
;    +16 jh. host-id (=sender host)
;    +18 jh. home-reg, jh. net-id
;    +20 process description(external process)

j0:  bz  w3  x2+s10    ; lookup process:
     rs. w3  r27.      ;   jh.linkno:=jh.linkno(mess);
     ls  w3  1         ;
     wa  w3  b4        ;
     rl  w3  x3        ;   sub:=sub(rcno);
     bl  w0  x3+p10    ;
     rs. w0  r22.      ;   kind:=subkind(sub);
     sn  w0  -2        ;
     am      v3<1-v0<1 ;   if sub=subhost then
     am      v0<1      ;     number of message entries:=v3
     al  w0  x3+p19    ;   else
     rs. w0  i0.       ;     number of message entries:=v1;
     al  w1  x3+p19    ;   max. buffers:=buffers free(sub);
     al  w0  0         ;   for entry=first message entry step 1 until last entry do
     bl  w2  x3+p16    ;     if entry used(<>0) then
j1:  se  w0 (x1)       ;       number of buffers:=number of buffers+1;
     al  w2  x2+1      ;
     al  w1  x1+2      ;
     se. w1 (i0.)      ;
     jl.     j1.       ;
     rs. w2  r24.      ;   max. buffers:=number of buffers;
     rl  w0  x3+p18    ;
     rs. w0  r25.      ;   max. buffersize:=max. buffersize(sub);
     dl  w1  x3+a11+2  ;
     ds. w1  r26.+2    ;   name of external process:=process name(sub);
     dl  w1  x3+a11+6  ;
     ds. w1  r26.+6    ;
     rl  w1  b19       ;
     rl  w0  x1+p5     ;
     rs. w0  r28.      ;   jh. host-id:=host-id(subhost);
     rl  w0  x1+p6     ;
     hs. w0  r29.      ;   jh. home-reg:=home-reg(subhost);
     rl  w0  x1+p7     ;
     hs. w0  r30.      ;   jh. net-id:=net-id(subhost);
     rs. w3  r31.      ;   process description:=sub;
c.p101 b.f1 w.         ;*****test73*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     73                ;
f0:  0                 ;
     jl.     f1.       ;
     al. w0  r20.      ;
     al. w1  r32.      ;   dump contents of input area
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test73*****
     rl  w2  b18       ;
     jl. w3  n1.       ;   deliver data(mess);
     am      0         ;    sender stopped: impossible;
     rl. w0 (r31.)     ;   if kind(sub)=remote subkind then
     sn  w0  p112      ;     link desc:=1
     am      2-1       ;   else
     al  w0  1         ;     link desc:=2;
     ls  w0  12        ;
     rs  w0  x2+s1     ;   return value:=ok;
     al  w3  s31       ;
     al  w0  s31>1*3   ;   bytes trf(mess), chars trf(mess):=std buffer size;
     ds  w0  x2+s3     ;
j4:  jl. w3  n19.      ; deliver:  deliver answer(ok,mess);
     jl     (b101)     ; exit: return to main;

; setstate.
; inserts a new state in the subhost description. the state has the
; interpretation-
;  state=0  closed, creation of subprocesses from the front end is pro-
;            hibited. local links may be created from this job host.
;  state=1  links may be created from the front end.
j5:  al  w3  2.11      ; setstate:
     la  w0  6         ;   state:=header mode;
     rs  w0  x1+s41    ; 
     al  w0  0         ;
     rs  w0  x2+s0     ;   status(mess):=ok;
     jl.     j4.       ;   goto deliver;

i0:  0                 ;

e.                     ; end of entry0;

; entry1.

b.i10,j10,m20 w.

q1:  jl. w3 (i2.)      ; entry1: find first unprocessed message;
c.p101 b.f1 w.         ;****test74*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     74                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x2        ;   dump contents of mess
     sn  w2  0         ;   if no mess then
     al  w0  x2+24     ;     no record
     al  w1  x2+22     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test74*****
     sn  w2  0         ;   if message queue empty then
     jl.    (i1.)      ;     goto no block;
     rs  w2  x1+s40    ;   current buffer:=mess;
     bz  w3  x2+s1     ;
     ls  w3  -2-1      ;   function:=fmode>2;
     jl.    (x3+i0.)   ;   goto case function of

i0:  m0                ;    ( 0-3   : create,
     m0                ;      4-7   : remove,
     m2                ;      8-11  : release link,
     m3                ;      12-15 : lookup,
     m3                ;      16-19 : lookup reserve,
     m3                ;      20-23 : cancel reservation,
     m6                ;      24-27 : linkup remote,
     m7                ;      28-31 : linkup local,
     m2                ;      32-35 : lookup link,
     -1                ;      36-39 : unused,
     m10               ;      40-43 : operator output/input,
     m10               ;      44-47 : operator output);

i1:  u3                ;
i2:  u12               ;

; create.
; remove.
;
m0:  rl  w3  x1+a50    ; create:
     bz  w0  x2+s1     ;
     ls  w0  -2        ;
     hs  w0  x3+p61    ; function(trm):=function( m buff)
     bz  w0  x2+10     ;
     hs  w0  x3+p69    ; receiver linkno(trm):=devno( m buff)
     bz  w0  x2+11     ;
     hs  w0  x3+p78    ; sender linkno(trm):=rcno( m buff)
     bz  w0  x2+12     ;
     hs  w0  x3+p68    ; bufno(trm):=bufno( m buff)
     bz  w0  x2+13     ;
     rs  w0  x3+p64    ; size(trm):= result( m buff)
     bz  w0  x2+20     ;
     hs  w0  x3+p62    ;   state(rec):=state(mess);
     rl  w0  x2+22     ;   status(rec):=mode(mess);
     rs  w0  x3+p63    ;
     rl  w0  x2+16     ; receiver net-id, home reg(trm):=
     rs  w0  x3+p301   ;        answer add1( m buff)
     rl  w0  x2+18     ; receiver host-id(trm):=
     rs  w0  x3+p303   ;        answer add2( m buff)
     jl      (b101)    ; return to main

; release.
; lookup link.
;
m2:  jl. w3  n4.       ; release: setup header1;
     jl     (b101)     ; exit: return;

; lookup.
; lookup reserve.
; cancel reservation.
;
m3:  jl. w3  n0.       ; lookup: get data buffer(mess);
     jl.     m16.      ;   sender stopped: goto stopped sender;
     ld  w0  -100      ;   ok:
     ds. w0  r8.       ;   value(unused fields):=0;
     rs. w0  r10.      ;
     jl.     j0.       ;   goto deliver;

; linkup remote.
;
m6:  jl. w3  n0.       ; linkup remote: get data buffer(mess);
     jl.     m16.      ;    sender stopped: goto stopped sender;
     al  w0  0         ;    ok:
     rs. w0  r7.       ;   jh.linkno:=0;
     se. w0 (r8.)      ;   if host-id=0 then
     jl.     j0.       ;     host-addr:=host-addr(subhost);
     rl  w0  x1+p5     ;
     rs. w0  r8.       ;
     bz  w0  x1+p6     ;
     hs. w0  r9.       ;
     bz  w0  x1+p7     ;
     hs. w0  r10.      ;
j0:  jl. w3  n2.       ; deliver:   check and packin(data);
     jl.     m17.      ;    error: goto parameter error;
j1:  jl. w3  n5.       ; setup: setup header2;
c.p101 b.f1 w.         ;*****test75*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     75                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+s100   ;   dump output buffer
     al  w1  x1+s100+s101-2
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test75*****
     jl     (b101)     ; exit: return;

; linkup local.
;
m7:  jl. w3  n0.       ; linkup local: get data buffer(mess);
     jl.     m16.      ;    sender stopped: goto stopped sender;
     rl  w0  x1+p5     ;    ok:
     rs. w0  r8.       ;   host-addr:=host-addr(subhost);
     bz  w0  x1+p6     ;
     hs. w0  r9.       ;
     bz  w0  x1+p7     ;
     hs. w0  r10.      ;
     jl. w3  n2.       ;   check and packin(data);
     jl.     m17.      ;    error: goto parameter error;
     rl. w2  r7.       ;    ok:
     am     (b18)      ;
     hs  w2  +s10      ;   jh.linkno(mess):=jh.linkno(data);
     ls  w2  1         ;
     wa  w2  b4        ;
     rl  w2  x2        ;   sub:=proc(jh. linkno);
     rs. w2  r11.      ;   process desc:=proc desc(sub);
     rl  w0  x2+a10    ;
     rl  w3  x2+a50    ;   if kind(sub)<>free subprocess
     sn  w0  p113      ;   or main(sub)<>0 then
     se  w3  0         ;     goto no resources;
     jl.     m15.      ;
     jl. w3  n25.      ;   create subprocess(sub,host);
     rl  w2  b18       ;
     rl. w3  r11.      ;
     rl  w0  x2+s6     ;
     rs  w0  x3+p5     ;   host-id(sub):=dh.host-id(mess);
     bz  w0  x2+s7     ;
     hs  w0  x3+p6     ;   home-reg(sub):=dh.home-reg(mess);
     bz  w0  x2+s8     ;
     hs  w0  x3+p7     ;   net-id(sub):=dh.net-id(mess);
     jl.     j1.       ;   goto setup;

; operator output.
; operator output-input.
;
m10:                   ; operator output:
     bz  w0  x2+s1     ;
     so  w0  2.1       ;   if function mode(mess)=1 then
     jl.     j2.       ;
     al  w0  0         ;
     hs  w0  x2+s4     ;     dh.linkno:=0;
     hs  w0  x2+s10    ;     jh.linkno:=0;
j2:  jl  w3  g34       ;   examine sender(mess);
     jl.     m16.      ;    sender stopped: goto stopped sender;
     jl  w3  g31       ;   increase stopcount(sender);
     jl. w3  n6.       ;   setup header3;
     jl     (b101)     ; exit: return to main;


; no resources in job host.
m15:                   ; no resources:
     rl  w2  b18       ;
     jl. w3  n14.      ;   return noresources answer;
     jl.     q1.       ;   goto entry1;


; stopped sender.
m16: rl  w2  b18       ; stopped sender:
     jl. w3  n12.      ;   return stopped answer;
     jl.     q1.       ;   goto entry1;

; parameter error in data.
m17: al  w0  3         ; parameter error: result:=3;
     jl  w3  g19       ;   deliver result;
     jl.     q1.       ;   goto entry1;

e.                     ; end of entry1;




; entry2.

b.i5,j5 w.

q2:                    ; entry2:
     al  w0  0         ;
     rs  w0  x1+p13    ;   current message:=0;
     jl. w3 (i0.)      ;   test after header and data transmitted;
     jl.     j0.       ;    error: goto test next;
                       ;    ok:
     rl  w2  x1+s40    ;
     bz  w0  x2+s1     ;
     so  w0  2.10<2    ;   if type(header)<>answer then
     jl.     j0.       ;     goto test next;
     rs  w2  b18       ; answer type:
     am     (x1+a50)   ;
     bz  w0  +p60      ;
     sn  w0  p161      ;   if int status=wait then
     rs  w2  x1+p13    ;    current mess:=mess;
     se  w0  p161      ;   else
     jl. w3  n27.      ;     release buffer;
j0:                    ; test next:
c.p101 b.f1 w.         ;*****test76*****
     rs. w3  f0.       ; 
     jl. w3  f4.       ;
     76                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1        ;
     al  w1  x1+p19+4  ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test76*****
     jl. w3  u12.      ;   find first unprocessed message;
     se  w2  0         ;   if mess<>0 then
     jl. w3  n21.      ;     testready and link;
     jl     (b101)     ; exit2: return;

i0:  u40               ;

e.



; entry3.

b.j10,i10 w.
q3:  jl. w3  n9.       ; entry3: get mess(bufno);
c.p101 b.f1 w.         ;*****test80*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     80                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x2+0      ;   dump contents of mess
     al  w1  x2+22     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test80*****
     rl  w3  x1+a50    ; 
     bz  w0  x3+p99    ;
     sn  w0  3         ;   if local function=reject then
     jl.     j3.       ;     goto rejected;
     bz  w0  x3+p81    ;
     se  w0  v23+1     ;   if function<>operator output-input then
     jl.     j1.       ;     goto lookup;
     jl. w3 (i0.)      ; operator output-input: test and increase stopcount;
     jl.     j0.       ;    error: goto setskip;
     rl  w3  x1+a50    ;    ok:
     rl  w0  x2+s2     ;   first:=first(mess);
     rs  w0  x3+p85    ;
c.-p103
     rl  w0  x2+s3     ;   last:=last(mess);
     rs  w0  x3+p86    ;   count:=0;
z.
c.p103-1
     al  w0  8         ;
     hs  w0  x3+p92    ;   address code:=dirty;
;    rs  w2  x3+p91    ;**untill addr code=6**   mss(rec):=mess;
z.
     jl.     j2.       ;   goto setok;

j3:                    ; rejected:
     bz  w0  x3+p81    ;
     se  w0  8         ;   if operation(rec)=release link
     sn  w0  29        ;   or operation(rec)=linkup local then
     jl. w3  n22.      ;     check and remove;
     jl. w3  n9.       ;   get mess buffer;
     al  w0  0         ;   bytes tranferred:=0;
     jl. w3  n11.      ;   return answer(bytes trf);

j0:  al  w0  p162      ; setskip:
     am     (x1+a50)   ;   internal status:=skip;
     hs  w0  +p80      ;
     jl. w3  u12.      ;   find first message;
     se  w2  0         ;   if mess<>0 then
     jl. w3  n21.      ;     testready and link;
     jl     (b101)     ; exit: return to main;

j1:                    ; lookup:
     al  w0  x1+s102   ;
     rs  w0  x3+p85    ;   first:=first(std input buffer);
c.-p103
     al  w0  x1+s102+s101-2
     rs  w0  x3+p86    ;   last:=first+size;
     al  w0  0         ;
     hs  w0  x3+p87    ;   charcount:=0;
z.
c.p103-1
     al  w0  s101>1*3  ;
     rs  w0  x3+p86    ;   size(rec):=std data size;
     al  w0  8         ;
     hs  w0  x3+p92    ;   address code:=dirty;
z.

j2:  al  w0  p160      ; setok:
     am     (x1+a50)   ;
     hs  w0  +p80      ;   internal status:=ok;
     jl     (b101)     ; exit: return;

i0:  u21               ;

e.                     ; end of entry3;


; entry 4.

b.i10,j20,m20 w.

q4:                    ; entry4:
     am     (x1+a50)   ;
     bz  w3  +p81      ;
c.p101 b.f1 w.         ;*****test84*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     84                ;
f0:  0                 ;
     jl.     f1.       ;
     rl  w3  x1+a50    ;
     al  w0  x3+p80    ;   dump param area(rec)
     al  w1  x3+p90    ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test84*****
     ls  w3  -1        ;
     jl.    (x3+i0.)   ;   goto case function of

i0:  m0                ;     (  0-3   : create,
     m1                ;        4-7   : remove,
     m2                ;        8-11  : release,
     m3                ;        12-15 : lookup,
     m3                ;        16-19 : lookup reserve,
     m3                ;        20-23 : cancel reservation,
     m6                ;        24-27 : linkup remote,
     m7                ;        28-31 : linkup local,
     m3                ;        32-35 : lookup link,
     -1                ;        36-39 : unused,
     m10               ;        40-43 : operator output-input,
     m11               ;        44-47 : operator output);


; create.
;
b.i10,j20 w.
m0:  jl. w3  n26.      ; create: get free buffer;
   
; initialize selected message buffer
     al  w0  -1        ;
     hs  w0  x2+8      ;
     al  w0  v32<2     ;
     hs  w0  x2+9      ;   mess(0):=-1,function;
     bz  w0  x3+p82    ;
     hs  w0  x2+20     ;   state(mess):=state(rec);
     rl  w0  x3+p83    ;
     rs  w0  x2+22     ;   mode(mess):=mode(rec);
     bz  w0  x3+p98    ;
     hs  w0  x2+10     ; devno(m buf):=sender lnkno(rec)
     rl  w0  x3+p321   ; answer add1(m buf):=
     rs  w0  x2+16     ;    sender net-id, sender home reg
     rl  w0  x3+p323   ;  answer add2(m buf):=
     rs  w0  x2+18     ;      sender host-id
     rl  w0  x1+s41    ;
     so  w0  2.1       ;   if state<>open then
     jl.     j13.      ;     goto error3;
     al  w0  p113      ; w0:= remote subkind
; find first free subprocess description.
     rl  w3  b4        ; for w3:=first dev in nametable until free found or last
     al  w3  x3-2      ;      begin
j6:  al  w3  x3+2      ;        if kind<>remote sub or
     sl  w3  (b5)      ;           main(proc)<>0 then
     jl.     j13.      ;                           free found:=false
     rl  w2  x3        ;                         else
     rl  w1  x2+a50    ;                           free found:=true
     sn  w0  (x2+a10)  ;      end;
     se  w1  0         ;
     jl.     j6.       ; if not( free found ) then goto error3
  
; free process description found: w2=free sub found, w3=add of subproc nametable entry
     ws  w3  b4        ; rcno:=(entry(sub) - entry(first dev))/2
     as  w3  -1        ;
     ds. w3  i1.       ; save sub, rcno - jobhost linkno -
     rl  w1  b19       ; w1:= host proc
     jl. w3  n25.      ; create subprocess
  
; transfer receive parameters to subprocess
     rl  w0  x1+a53    ;
     rs  w0  x2+a53    ; *users(sub):=users(subhost)
     rl  w1  x1+a50    ; w1:=main
     rl  w0  x1+p84    ;
     al  w3  0         ;
     wd  w0  g48       ;
     ls  w0  1         ;   max buffersize(sub):=size(rec)/3*2;
     rs  w0  x2+p18    ;
     bz  w0  x1+p88    ;
     hs  w0  x2+p16    ; buffers free(sub):=bufno(rec)
     al  w0  8.377     ;
     la  w0  x1+p83    ;
     hs  w0  x2+p10    ; subkind(sub):=status(rec)(16:23);
     bz  w0  x1+p98    ;
     hs  w0  x2+p11    ; devno(sub):= sender linkno(rec)
     rl. w0  i1.       ;
     hs  w0  x2+p9     ; rcno(sub):= saved rcno
     bz  w0  x1+p82    ;
     ls  w0  5         ;
     rl  w3  x1+p83    ;
     ls  w3  -8        ;
     lo  w0  6         ;   data quality(sub):=state(mess)<5+mode(mess)(0:4);
     hs  w0  x2+p8     ; *data quality(sub):=quality mask(rec)
     bz  w0  x1+p321   ;
     hs  w0  x2+p7     ; receiver net-id(sub):=sender net-id(rec)
     bz  w0  x1+p322   ;
     hs  w0  x2+p6     ; receiver home reg(sub):=sender home reg(rec)
     al  w0  0         ;***until net-id and home-reg are defined in the net:
     rs  w0  x2+p6     ;   net-id, home-reg:=0,0;
     rl  w0  x1+p323   ; receiver host-id(sub):=sender host-id(rec)
     rs  w0  x2+p5     ;
c.p101 b.f1 w.         ;*****test85*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     85                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x2-4      ;
     al  w1  x2+p19+14 ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test85*****
     rl  w1  b19       ; w1:=host proc
     rl  w2  b18       ; w2:=mess buff
         
; set rcno in message  buffer; receive param internal status:= ok;
; link message to event queue of host and if host not already in
; main queue then link it first in main queue. finnally return
; to main initialize return point.
     rl  w3  x1+a50    ; w3:=main
     rl. w0  i1.       ;
     hs  w0  x2+11     ; rcno(m buf):=saved rcno
     al  w0  p160      ;
     hs  w0  x3+p80    ; internal status(rec):=ok
c.p101 b.f1 w.         ;*****test86*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     86                ;
f0:  0                 ;
     jl.     f1.       ;
     rl. w3  f0.       ;
     al  w0  x3+p80    ;
     al  w1  x3+p90    ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test86*****
     jl. w3  n20.      ;   link operation;
     jl. w3  n21.      ;   testready and link;
     rl. w2  i0.       ; return: w2:=sub created
     am     (b101)     ;
     jl      -2        ; return to main init

; error.
j10: am      0-1       ;
j12: am      1-3       ; error1:
j13: am      3-5       ; error3:
j9 : al  w0  5         ; error5:
c.p101 b.f1 w.         ;*****test87*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     87                ;
f0:  0                 ;
     jl.     f1.       ;
     rs  w0  x3        ;
     al  w0  x3        ;
     al  w1  x3        ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test87*****
     rl  w2  b18       ;
     hs  w0  x2+13     ; result(m buf):=case error _entry of ((0),1,3,5)
j14: rl  w1  b19       ; out:
     rl  w3  x1+a50    ;
     al  w0  p160      ; 
     hs  w0  x3+p80    ;  internal state(main):=ok
     jl. w3  n20.      ;   link operation;
     jl. w3  n21.      ;   testready and link;
     jl     (b101)     ;         


; remove.
;
m1:  jl. w3  n26.      ; remove: get free mess buffer;
     al  w0  -1        ;
     hs  w0  x2+8      ;
     al  w0  v38<2     ;
     hs  w0  x2+9      ;   mess(0):=-1,function;
     bz  w0  x3+p88    ;
     hs  w0  x2+12     ; bufno(m buf):= bufno(rec)
     bz  w0  x3+p98    ;
     hs  w0  x2+10     ;   dh.linkno(mess):=dh.linkno(rec);
     bz  w0  x3+p89    ;
     hs  w0  x2+11     ;   jh.linkno(mess):=jh.linkno(rec);
     rl  w0  x3+p321   ; answer add1(m buf):=
     rs  w0  x2+16     ;   sender net-id,home reg(rec)
     rl  w0  x3+p323   ; answer add2(m buf):=
     rs  w0  x2+18     ;   sender host-id
     bz  w2  x3+p89    ;
     ls  w2  1         ;
     wa  w2  b4        ;
     rl  w2  x2        ; sub:=proc(rcno)
     rl  w0  x2+a10    ;
     la  w0  g50       ; if kind(subproc kind)<>sub or
     sn  w0  p112      ;    main(sub)<>main(host)
     se  w3  (x2+a50)  ;
     jl.     j12.      ;         then goto error1
     bz  w0  x3+p98    ;
     bs  w0  x2+p11    ;
     bz  w3  x3+p89    ;
     bs  w3  x2+p9     ;
     sn  w0  0         ;   if dh.linkno(sub)<>dh.linkno(mess)
     se  w3  0         ;   or jh.linkno(sub)<>jh.linkno(mess) then
     jl.     j12.      ;     goto error1;
     jl. w3  n24.      ;   remove subprocess(sub);
c.p101 b.f1 w.         ;*****test88*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     88                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x2-4      ;
     al  w1  x2+p19+14 ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test88*****
     rl  w2  b18       ;
     jl.     j14.      ;   goto out;

j20: al  w0  p163      ; error4:
     hs  w0  x3+p80    ;   internal status:=reject;
     jl     (b101)     ;   return(std);

; parameters.

i0:  0                 ; subproc
i1:  0                 ; rcno
i2:  0                 ; devno

e.

; release.
;
m2:  jl. w3  n9.       ; release: 
     am     (x1+a50)   ;
     rl  w0  +p84      ;
     sn  w0  0         ;   if result=ok then
     jl.     j0.       ;     goto deliver;
     rl  w3  x2+s9     ; notok:
     bz  w0  x2+s11    ;   if jh.host-id(mess)<>jh.host-id(subhost)
     bs  w0  x1+p7     ;   or jh.net-id(mess)<>jh.net-id(subhost) then
     sn  w3 (x1+p5)    ;     goto deliver;
     se  w0  0         ;
     jl.     j0.       ;
     bz  w3  x2+s10    ;
     ls  w3  1         ;
     wa  w3  b4        ;
     rl  w3  x3        ;
     rl  w0  x2+s6     ;   sub:=proc(jh.linkno);
     bz  w1  x2+s8     ;   if dh.host-id(mess)=dh.host-id(sub)
     bs  w1  x3+p7     ;   and dh.net-id(mess)=dh.net-id(sub)
     sn  w0 (x3+p5)    ;   and dh.linkno(mess)=dh.linkno(sub)
     se  w1  0         ;   and jh.linkno(mess)=jh.linkno(sub) then
     jl.     j10.      ;     remove subprocess(sub);
     bz  w0  x2+s4     ;
     bs  w0  x3+p11    ;
     bz  w1  x2+s10    ;
     bs  w1  x3+p9     ;
     sn  w0  0         ;
     se  w1  0         ;
     jl.     j10.      ;
     al  w2  x3        ;
     jl. w3  n24.      ;
j10: rl  w1  b19       ;
     rl  w2  b18       ;
j0:  al  w0  0         ; deliver:
j1:  jl. w3  n11.      ;   return answer;
c.p101 b.f1 w.         ;*****test89*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     89                ;
f0:  0                 ;
     jl.     f1.       ;
     rl  w2  b18       ;
     al  w0  x2+0      ;
     al  w1  x2+22     ;   dump contents of mess
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test89*****
     jl. w3  u12.      ;   find first message;
     se  w2  0         ;   if mess<>0 then
     jl. w3  n21.      ;     testready and link;
     jl     (b101)     ; exit: return to main;

; lookup.
; lookup reserve.
; cancel reservation.
; lookup link.
;
m3:  jl. w3  n9.       ; lookup:
     jl. w3  n18.      ;   return operation;
     jl.     j1.       ;   goto release;


; linkup remote.
;
m6:  jl. w3  n9.       ; linkup remote:
     jl. w3  n18.      ;   return operation;
     am     (x1+a50)   ;
     rl  w3  +p84      ;   result:=size(rec);
     sz  w3  8.77      ;   if result<>ok then
     jl.     j1.       ;     goto release;
     rl  w3  x2+6      ;   proc:=sender(mess);
     sh  w3  0         ;   if proc<0 then
     ac  w3  x3        ;     proc:=-proc;
     rl  w3  x3+a14    ;
     am.    (r31.)     ;
     rs  w3  +a53      ;   users(sub):=sender(mess);
     jl.     j1.       ;   goto release;

; linkup local.
;
m7:  jl. w3  n9.       ; linkup local:
     jl. w3  n3.       ;    packout(buffer);
     rl  w3  x1+a50    ;
     rl  w0  x3+p84    ;   result:=size(18:23);
     bz  w3  x3+p99    ;
     se  w3  3         ;   if local function=reject
     sz  w0  8.77      ;   or result<>0 then
     jl.     j2.       ;     goto clear subprocess;
; initiate process description.
     rl. w2  r31.      ;
     al  w0  p112      ;
     rs  w0  x2+a10    ;   kind(sub):=local kind;
     am     (b18)      ;
     rl  w3  +6        ;   proc:=sender(mess);
     sh  w3  0         ;
     ac  w3  x3        ;
     rl  w0  x3+a14    ;
j7:  rl  w3  x3+a34    ;   users(sub):=proc+all ancestors(proc);
     sn  w3  0         ;
     jl.     j8.       ;
     lo  w0  x3+a14    ;
     jl.     j7.       ;
j8:  rs  w0  x2+a53    ;
     rl. w0  r32.      ;
     hs  w0  x2+p11    ;   dh.linkno(sub):=dh.linkno;
     rl. w0  r27.      ;
     hs  w0  x2+p9     ;   jh. linkno(sub):=jh.linkno;
     rl. w0  r22.      ;
     hs  w0  x2+p10    ;   subkind(sub):=subkind;
     rl. w0  r24.      ;
     hs  w0  x2+p16    ;   buffers free(sub):=max buffers;
     rl. w0  r25.      ;
     al  w3  0         ;
     wd  w0  g48       ;
     ls  w0  1         ;
     rs  w0  x2+p18    ;   max bufsize(sub):=max.bufsize/3*2;
     rl  w2  b18       ;
     jl. w3  n1.       ;   deliver data;
     am      0-s31     ;    error: size:=0;
     al  w0  s31       ;   ok: size:=std buffer size;
     rl. w3  r32.      ;
     hs  w3  x2+s4     ;   dh.linkno(mess):=dh.linkno;
     jl. w3  n11.      ;   return answer;
c.p101 b.f1 w.         ;*****test90*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     90                ;
f0:  0                 ;
     jl.     f1.       ;
     rl  w2  b18       ;
     al  w0  x2+0      ;   dump contents of mess
     al  w1  x2+22     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test90*****
     jl. w3  u12.      ;   find first message;
     se  w2  0         ;   if mess<>0 then
     jl. w3  n21.      ;     testready and link;
     rl. w2  r31.      ; init-exit:
     am     (b101)     ;
     jl      -2        ;   return to main(init);

; clear subprocess description.
j2:  am     (b18)      ; clear process:
     bz  w2  +s10      ;
     ls  w2  1         ;
     wa  w2  b4        ;   sub:=word(jh.linkno(mess)<1+base(name table));
     rl  w2  x2        ;
     jl. w3  n24.      ;   remove subprocess(sub);
     rl  w2  b18       ;
     rl  w3 (x1+a50)   ;
     bz  w0  x3+p81    ;
     bz  w3  x3+p99    ;
     sz  w0  2.1       ;   if datas
     sn  w3  3         ;   and local function<>reject then
     sz                ;
     jl. w3  n1.       ;     deliver data(mess);
     am      0-s31     ;      sender stopped: charcount:=0;
     al  w0  s31       ;      ok: charcount:=std data size;
     jl.     j1.       ;   goto deliver;


; operator output-input.
;
m10: jl. w3  n9.       ; operator output-input:
     am     (x1+a50)   ;
     bz  w0  +p81      ;
     so  w0  2.1       ;   if no datas received then
     jl.     j0.       ;     goto deliver size0;
     am     (x1+a50)   ;
     bz  w2  +p88      ;   bufno:=bufno(rec);
     jl. w3  u18.      ;   test and decrease stopcount;
c.-p103
     rl  w2  b18       ;
     al  w0  2         ;
     wa  w0  x2+s3     ;   bytes trf:=last(mess)-first(mess)+2;
     ws  w0  x2+s2     ;
z.
c.p103-1
     am     (x1+a50)   ;
     rl  w0  +p86      ;   bytes trf:=size(data);
     jl. w3  u15.      ;   convert bytes8 to bytes12;
z.
     jl.     j1.       ;   goto deliver size;


; operator output.
;
m11: jl. w3  n9.       ; operator output:
     jl.     j0.       ;   goto deliver;

e.                     ; end of entry4.


c.p101
; stepping stones.
     jl.     f4.       ;
f4=k-2
     jl.     f5.       ;
f5=k-2
     jl.     f6.       ;
f6=k-2
z.


; subprocesdures used in subhost.

; get data.
; copies a data area defined by current message buffer from sender to std driver
; buffer.
;        call:         return:
; w0                   destroyed
; w1     subhost       unchanged
; w2     mess          unchanged
; w3     link          destroyed
b.i5,j5 w.
n0:
     ds. w3  i1.       ; get data buffer:
     al  w0  s31       ;   bytecount:=std size(data);
     al. w1  r0.       ;   first addr:=start(int driver buffer);
c.-p103
     wa  w0  x2+10     ;
     rl  w2  x2+10     ;
j0:  rl  w3  x2        ;
     rs  w3  x1        ;
     al  w2  x2+2      ;
     al  w1  x1+2      ;
     se  w2 (0)        ;
     jl.     j0.       ;
     rl  w1  b19       ;
     dl. w3  i1.       ;
     jl      x3+2      ;
z.
c.p103-1
     jl  w3  g36       ;   copy from buffer(mess);
     rl  w1  b19       ;
     se  w0  0         ;   if result<>0 then
     jl.    (i1.)      ;     return to link;
     am.    (i1.)      ;
     jl      +2        ;   return to link+2;
z.
i0:  0                 ;
i1:  0                 ;

e.

; deliver data.
; transfers a datablock from std driver buffer to an internal process. the
; buffer is defined in a message buffer.
;        call:         return:
; w0                   destroyed
; w1     subhost       unchanged
; w2     mess          unchanged
; w3     link          destroyed
b.i5,j5 w.
n1:
     ds. w3  i1.       ; get data buffer:
     al  w0  s31       ;   bytecount:=std size(data);
     al. w1  r20.      ;   first addr:=start(int driver buffer);
c.-p103
     wa  w0  x2+10     ;
     rl  w2  x2+10     ;
j0:  rl  w3  x1        ;
     rs  w3  x2        ;
     al  w2  x2+2      ;
     al  w1  x1+2      ;
     se  w2 (0)        ;
     jl.     j0.       ;
     rl  w1  b19       ;
     dl. w3  i1.       ;
     jl      x3+2      ;
z.
c.p103-1
     jl  w3  g35       ;   copy to buffer(mess);
     rl  w1  b19       ;
     se  w0  0         ;   if result<>0 then
     jl.    (i1.)      ;     return to link;
     am.    (i1.)      ;
     jl      +2        ;   return to link+2;
z.
i0:  0                 ;
i1:  0                 ;
e.

; check and packin(buffer).
; checks the values of the different fields and packs the data buffer into the
; std output buffer in the process description of hostprocess. return to link
; in case of errors else to link+2.
;        call:         return:
; w0                   destroyed
; w1     subhost       unchanged
; w2                   unchanged
; w3     link          destroyed
b.i10 w.
n2:  rs. w3  i0.       ; check and packin:
     bl. w3  r1.       ;
     sl  w3  -1        ;   if mode<-1
     sl  w3  1<8       ;   or mode>255 then
     jl.    (i0.)      ;     return to link;
     bl. w0  r2.       ;
     sl  w0  -1        ;   if subkind<-1
     sl  w0  1<8       ;   or subkind>255 then
     jl.    (i0.)      ;     return to link;
     ls  w0  16        ;
     ld  w0  8         ;
     rl. w0  r3.       ;
     sz. w0 (i4.)      ;   if size(timeout) or size(buffers)>=8 bits then
     jl.    (i0.)      ;     return to link;
     ls  w0  4         ;
     ld  w0  8         ;   word0(outarea):=
     rs  w3  x1+s100+0 ;     mode<16+subkind<8+timeout;
     ls  w0  4         ;
     rl. w3  r5.       ;
     sz. w3 (i7.)      ;   if size(buffer size)>=16 bits then
     jl.    (i0.)      ;     return to link;
     lo  w0  6         ;
     rs  w0  x1+s100+2 ;   word1(outarea):=buffers<16+buffer size;
     rl. w3  r7.       ;
     sz. w3 (i6.)      ;   if size(jh.linkno)>=10 bits then
     jl.    (i0.)      ;     return to link;
     ls  w3  8         ;
     rl. w0  r10.      ;
     sz. w0 (i5.)      ;   if size(jh.net-id)>=8 bits then
     jl.    (i0.)      ;     return to link;
     lo  w0  6         ;
     rs  w0  x1+s100+8 ;   word4(outarea):=jh.linkno<8+jh.net-id;
     bz. w0  r9.       ;
     sz. w0 (i5.)      ;   if size(jh.home-reg)>=8 bits then
     jl.    (i0.)      ;     return to link;
     ls  w0  16        ;
     rl. w3  r8.       ;
     sz. w3 (i7.)      ;   if size(jh.host-id)>=16 bits then
     jl.    (i0.)      ;     return to link;
     lo  w0  6         ;   word5(outarea):=
     rs  w0  x1+s100+10;     jh.home-reg<16+jh.host-id;
     dl. w0  r6.+2     ;
     ds  w0  x1+s100+14;
     dl. w0  r6.+6     ;   word6-9(outarea):=
     ds  w0  x1+s100+18;     devicename;
     am.    (i0.)      ;
     jl      +2        ; exit: return to link+2;

i0:  0                 ; saved link
i4:  8.7400 7400       ;
i5:  8.7777 7400       ;
i6:  8.7777 6000       ;
i7:  8.7760 0000       ;

e.

; packout.
; packs out a buffer from the std. input buffer in the process description of
; the subhost process. the parameters are delivered in the std. driver input
; buffer.
;        call:         return:
; w0                   destroyed
; w1     subhost       unchanged
; w2                   destroyed
; w3     link          destroyed
b.i5 w.
n3:  rs. w3  i0.       ; packout:
     rl  w0  x1+s102+0 ;
     ls  w0  -8        ;
     la. w0  i4.       ;
     rs. w0  r22.      ;   subkind:=word0(8:15);
     rl  w0  x1+s102+2 ;
     al  w3  0         ;
     ld  w0  8         ;
     rs. w3  r24.      ;   max. buffers:=word1(0:7);
     ls  w0  -8        ;
     rs. w0  r25.      ;   max. buffersize:=word1(8:23);
     rl  w0  x1+s102+4 ;
     ls  w0  -8        ;
     la. w0  i5.       ;
     rs. w0  r32.      ;   dh.linkno:=word2(6:15);
     rl  w3  x1+s102+8 ;
     ld  w0  -8        ;
     la. w3  i5.       ;
     rs. w3  r27.      ;   jh.linkno:=word4(6:15);
     ld  w0  -16       ;
     hs. w0  r30.      ;   jh.net-id:=word4(16:23);
     rl  w0  x1+s102+10;
     ld  w0  8         ;
     hs. w3  r29.      ;   jh.home-reg:=word5(0:7);
     ls  w0  -8        ;
     rs. w0  r28.      ;   jh.host-id:=word5(8:23);
     al  w0  0         ;***jh.home-reg,jh.net-id:=0
     rs. w0  r29.      ;*** used until they are defined from the dev contr
     dl  w0  x1+s102+14;
     ds. w0  r26.+2    ;
     dl  w0  x1+s102+18;
     ds. w0  r26.+6    ;   devicename:=word6-9(inarea);
     rl. w3  r27.      ;
     ls  w3  1         ;
     wa  w3  b4        ;
     rl  w3  x3        ;
     bz  w0  x1+p7     ;
     bs. w0  r30.      ;
     rl  w2  x1+p5     ;
     sn  w0  0         ;   if jobhost(data)=jobhost(subhost) then
     se. w2 (r28.)     ;    proc desc:=word(jh.linkno<1+base(nametable));
     al  w3  0         ;   else
     rs. w3  r31.      ;     proc desc:=0;
     jl.    (i0.)      ; exit: return;

i0:  0                 ; saved link
i4:  8.0000 0377       ;
i5:  8.0000 1777       ;

e.

; setup header1.
; this procedure sets up the header transmission parameters according to
; the format used of release link and lookup link.
;
; setup header2.
; this procedure sets up the header transmission parameters according to 
; the format used of lookup, lookup reserve, cancel reservation, linkup
; remote and linkup local.
;
; setup header3.
; this procedure sets up the header transmission parameters according to
; the format used of operaor output and operator output-input.
;
;        call:         return:
; w0                   destroyed
; w1     subhost       unchanged
; w2     mess          unchanged
; w3     link          destroyed
b.i5,j5 w.
n4:  ds. w3  i1.       ; setup header1:
     rl  w3  x1+a50    ;
     rl  w0  x2+s9     ;
     rs  w0  x3+p64    ;   size:=jh.host-id;
     bz  w0  x2+s11    ;
     rs  w0  x3+p63    ;   mode:=jh.net-id;
     jl.     j0.       ;   goto common part;

n5:  ds. w3  i1.       ; setup header2:
     rl  w3  x1+a50    ;
     al  w0  x1+s100   ;
     rs  w0  x3+p65    ;   first:=first(outarea);
c.-p103
     al  w0  x1+s100+s101-2;
     rs  w0  x3+p66    ;   last:=last(outarea);
     al  w0  s101>1*3  ;****midlertidigt
     rs  w0  x3+p64    ;*****
z.
c.p103-1
     al  w0  s101>1*3  ;
     rs  w0  x3+p66    ;   size:=std buffer size;
     al  w0  8         ;
     hs  w0  x3+p72    ;   address code:=dirty;
z.
     jl.     j1.       ;   goto common2;

n6:  rs. w3  i1.       ; setup header3:
     al  w0  x2+1      ;
     rs. w0  i0.       ;   saved mess:=uneven mess;
     rl  w0  x2+s2     ;
     am     (x1+a50)   ;
     rs  w0  +p65      ;   first(trm):=first(mess);
     al  w0  2         ;
     wa  w0  x2+s3     ;
     ws  w0  x2+s2     ;   size12:=last(mess)+2-first(mess);
     jl. w3  u14.      ;   convert size12 to size8;
     rl  w3  x1+a50    ;
     rs  w0  x3+p64    ;   size(trm):=size8;
c.-p103
     rl  w0  x2+s3     ;
z.
     rs  w0  x3+p66    ;   last(trm):=last(mess);
                       ;   charcount(trm):=0;
c.p103-1
     al  w0  8         ;
     hs  w0  x3+p72    ;   addr code:=dirty;
z.
j0:  bz  w0  x2+s4     ; common1:
     hs  w0  x3+p69    ;   rec.linkno:=dh.linkno(mess);
     bz  w0  x2+s10    ;
     hs  w0  x3+p78    ;   sender linkno(trm):=jh.linkno(mess);

j1:  bz  w0  x2+s1     ; common2:
     ls  w0  -2        ;   internal status:=ok, function(trm):=header function(mess);
     hs  w0  x3+p61    ;   state(trm):=0;
     al  w0  2.11      ;
     la  w0  x2+s1     ;
     rs  w0  x3+p63    ;   mode(trm):=function mode(mess);
     bz  w0  x2+s8     ;
     hs  w0  x3+p301   ;   receiver net-id(trm):=dh.net-id(mess);
     bz  w0  x2+s7     ;
     hs  w0  x3+p302   ;   receiver home-reg(trm):=dh.home-reg(mess);
     rl  w0  x2+s6     ;
     rs  w0  x3+p303   ;   receiver host-id(trm):=dh.host-id(mess);
     rl. w2  i0.       ;   mess:=saved mess;
     jl. w3  n10.      ;   get next free message entry(host);
     la  w2  g50       ;   mess:=even mess;
     am     (x1+a50)   ;
     hs  w3  +p68      ;   bufno(trm):=current bufno;
     jl.    (i1.)      ; exit: return;

i0:  0                 ; saved mess
i1:  0                 ; saved link

e.

; get mess buffer.
;
;        call:         return:
; w0                   unchanged
; w1     subhost       unchanged
; w2                   mess buffer(bufno)
; w3     link          unchanged
b. w.
n9:  am     (x1+a50)   ; get mess:
     bz  w2  +p88      ;
     am      x2        ;
     am      x2        ;
     rl  w2  x1+p19    ;   mess:=even message addr(bufno);
     la  w2  g50       ;
     rs  w2  b18       ;   current buffer:=mess;
     jl      x3        ;   return;
e.

; get next free message entry.
; finds the next free mess entry in the message table, and inserts the value in
; current bufno. mess - even or uneven - is inserted in the mess entry.
;        call:         return:
; w0                   destroyed
; w1     subhost       unchanged
; w2     mess          unchanged
; w3     link          bufferno
b.i0,j1 w.
n10: rs. w3  i0.       ; get next free mess entry:
     al  w0  -1        ;
     ba  w0  x1+p16    ;   buffers free:=buffers free-1;
     hs  w0  x1+p16    ;
     al  w0  0         ;
     bz  w3  x1+p17    ;
     al  w3  x3-1      ;
j0:  al  w3  x3+1      ;
     sl  w3  v3        ;
     al  w3  0         ;
     am      x3        ;
     am      x3        ;
     se  w0 (x1+p19)   ;
     jl.     j0.       ;
j1:  hs  w3  x1+p17    ;
     am      x3        ;
     am      x3        ;
     rs  w2  x1+p19    ;   insert message in mess entry;
     ac  w0 (x2+4)     ; 
     sh  w0  0         ;   if sender(mess)>0 then
     rs  w0  x2+4      ;     sender(mess):=-sender(mess);
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link

e.

; return answer.
;
;        call:         return:
; w0     bytes trf     destroyed
; w1     subhost       unchanged
; w2     mess          destroyed
; w3     link          destroyed
b.i0 w.
n11: rs. w3  i0.       ; return answer:
     rl  w3  0         ;
     ls  w0  -1        ;
     wa  w0  6         ;   bytes trf(mess):=bytes trf;
     ds  w0  x2+s3     ;   chars trf(mess):=bytes trf*3/2;
     am     (x1+a50)   ;
     rl  w3  +p84      ;
     ld  w0  -8        ;
     ls  w3  2         ;
     ld  w0  2         ;
     ls  w3  6         ;
     ld  w0  6         ;
     am     (x1+a50)   ;
     rl  w0  +p99      ;
     sn  w0  3         ;   if local function=reject then
     al  w3  8         ;     function result:=8;
     rs  w3  x2+s0     ;   return value:=device status<16+linkno descriptor<12+function result;
     rl. w0  r32.      ;
     hs  w0  x2+s4     ;   dh.linkno(mess):=dh.linkno;
     jl. w3  u11.      ;   clear message entry;
     jl. w3  n19.      ;   deliver answer(ok,buf);
am (x1+a50)
bz w0 +p81
sn w0 42
am    p162-p160
     al  w0  p160      ;
     am     (x1+a50)   ;
     hs  w0  +p80      ;   internal status(rec):=ok;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link;
e.

; return stopped answer.
;
;        call:         return:
; w0                   destroyed
; w1     subhost       unchanged
; w2     mess          destroyed
; w3     link          destroyed
b.i0 w.
n12: am      -1+2      ; return stopped answer:
n13: am      -2-3      ; return relected answer:
n14: al  w0  3         ; return noresources answer:
     rs. w3  i0.       ;
     rs  w0  x2+s1     ;   function result:=-1;
     ld  w0  -100      ;
     ds  w0  x2+s3     ;   bytes, chars trf:=0,0;
     jl. w3  n19.      ;   deliver answer(ok,mess);
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link
e.


; return operation.
;        call:         return:
; w0                   size
; w1     subhost       unchanged
; w2                   message
; w3     link          destroyed
b.i4,j4 w.
n18: rs. w3  i0.       ; return operation:
     rl  w3  x1+a50    ;
     bz  w0  x3+p81    ;
     bz  w3  x3+p99    ;
     sz  w0  2.1       ;   if no datas
     sn  w3  3         ;   or local function=reject then
     jl.     j0.       ;     size:=0;
     jl. w3  n3.       ;   else
     rl  w2  b18       ;     packout;
     jl. w3  n1.       ;     deliver data;
j0:  am      0-s31     ;    sender stopped: size:=0;
     al  w0  s31       ;    ok: size:=std size;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; save link
e.


; deliver answer(ok,mess).
;
;        call:         return:
; w0                   destroyed
; w1     subhost       unchanged
; w2     mess          destroyed
; w3     link          destroyed
b.i0 w.
n19:                   ; deliver answer:
c.-p103
     al  w0  1         ;
     rs  w0  x2+4      ;   result(mess):=0k;
     jl      d15       ;   deliver answer(mess);
z.
c.p103-1
     rs. w3  i0.       ;
     dl  w0  x2+10     ;
     ds  w0  g21       ;
     dl  w0  x2+14     ;   transfer 5 words from buffer to
     ds  w0  g23       ;     answer area to possibilitate
     rl  w0  x2+16     ;     the use of g18
     rs  w0  g24       ;
     jl  w3  g18       ;   deliver result(ok);
     jl.    (i0.)      ; exit: return;
i0:  0                 ;  saved link
z.
e.


; link operation.
;
;        call:         return:
; w0                   destroyed
; w1     proc          unchanged
; w2     mess          destroyed
; w3     link          destroyed
b.i0 w.
n20: rs. w3  i0.       ; link operation:
     al  w1  x1+a54    ;
     jl  w3  d6        ;
     al  w1  x1-a54    ;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link
e.


; testready and link.
; if the subhost is in mainproc queue, the state of the subhost is ready
; and there is free buffers the subhost is linked in the main process queue.
;        call:         return:
; w0                   destroyed
; w1     proc          destroyed
; w2                   destroyed
; w3     link          destroyed
b.i1 w.
n21: rl  w0  x1+p14    ; testmore:
     se  w0  x1+p14    ;   if proc already in mainproc queue then
     jl      x3        ;     return to link;
     rl  w0  x1+p12    ;
     se  w0  0         ;   if state(proc)<>0 then
     jl      x3        ;     return to link;
     bl  w0  x1+p16    ;
     sh  w0  0         ;   if buffers free=<0 then
     jl      x3        ;     return to link;
     al  w2  x1+p14    ; 
     rl  w1  x1+a50    ;   main:=main(host);
     rl  w1  x1+p14    ;   queue head:=last(mainproc queue);
     jl      d6        ;   link(head,elem);
                       ; exit: return to link;
e.


; procedure check and remove.
;        call:         return:
; w0                   destroyed
; w1     subhost       unchanged
; w2                   destroyed
; w3     link          destroyed
b.i4 w.
n22: rs. w3  i0.       ; check and remove:
     rl  w3  x1+a50    ;
     bz  w2  x3+p89    ;
     ls  w2  1         ;
     wa  w2  b4        ;   sub:=proc(jh.linkno(rec));
     rl  w2  x2        ;
     rl  w0  x3+p93    ;
     sn  w0 (x2+p5)    ;   if main(sub)=main
     se  w3 (x2+a50)   ;   and dh.host-id(sub)=dh.host-id(rec)
     jl.    (i0.)      ;   and dh.net-id(sub)=dh.net-id(rec) then
     bz  w0  x3+p91    ;     remove subprocess(sub);
     bs  w0  x2+p7     ;
     sn  w0  0         ;
     jl. w3  n24.      ;
     jl.    (i0.)      ; exit: return;
i0:  0                 ;
e.


; remove  subprocess(sub).
; removes a subprocess by returning all messages in the event queue 
; with dummy answer and clearing the mainproc addr.
;        call:         return:
; w0                   destroyed
; w1                   unchanged
; w2     subproc       unchanged
; w3     link          destroyed
b.i2 w.
v102:                  ;
n24: rs. w3  i0.       ; remove subprocess: save link;
     rs. w1  i1.       ;   save w1;
c.p101 b.f1 w.         ;*****test94*****
     rs. w3  f0.       ; 
     jl. w3  f4.       ;
     94                ;
f0:  0                 ;
     jl.     f1.       ;
     rs  w2  x3        ;
     al  w0  x3        ;
     al  w1  x3        ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test94*****
     jl. w3 (i2.)      ;   clean subproc(sub);
     al  w0  p113      ;
     rs  w0  x2+a10    ;   kind(sub):=remote subproc kind;
     ld  w0  -100      ;
     ds  w0  x2+a11+2  ;   name(subproc):=0;
     ds  w0  x2+a11+6  ;
     rs  w0  x2+a50    ;   mainproc(subproc):=0;
     ds  w0  x2+a53    ;   reserver, users :=0;
     rl. w1  i1.       ;   restore w1;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link
i1:  0                 ; saved w1
i2:  v101              ;   address of clean subprocess
e.


; create subprocess.
;        call:         return:
; w0                   destroyed
; w1     hostproc      unchanged
; w2     subproc       unchanged
; w3     link          destroyed
b.i10,j10 w.
n25: rs. w3  i0.       ; create subprocess: save link;
     ds. w2  i2.       ;   save host, sub;
     al  w0  0         ;   insert zeroes in
     al  w3  x2+2      ;     process description;
j0:  rs  w0  x3        ;
     al  w3  x3+2      ;
     sh  w3  x2+a79-2  ;
     jl.     j0.       ;
     dl  w0  x1+a49    ;
     ds  w0  x2+a49    ;   interval(sub):=interval(subhost);
     rl  w0  x1+a50    ;
     rs  w0  x2+a50    ;   main(sub):=main(host);
     al  w0  x2+a54    ;   initiate next,last event;
     rs  w0  x2+a54    ;
     rs  w0  x2+a55    ;
     al  w1  x2+p14    ;
     rs  w1  x2+p14    ;   next, last subproc(sub):=sub;
     rs  w1  x2+p15    ;
; generate name - <:sub<number>:>
j1:  al  w1  1         ;
     wa. w1  i3.       ;   number:=number+1;
     sl  w1  1000      ;   if number>=1000 then
     al  w1  0         ;     number:=0;
     rs. w1  i3.       ;
     ld  w0  -100      ;
     wd. w1  i4.       ;   w1:=cif1;
     wd. w0  i5.       ;   w0:=cif2;
     ls  w1  8         ;   w3:=cif3;
     wa  w1  0         ;   number:=
     ls  w1  8         ;     cif1<16+cif2<8+cif3
     wa  w1  6         ;     + 48<16+  48<8+  48;
     lo. w1  i7.       ;   name:=<:sub:>,number;
; check name. if name already exists as device name then
; generate a new name.
     rl  w2  b4        ;   entry:=first entry in name table;
     al  w2  x2-2      ;
j2:  rl. w0  i6.       ; next:
j3:  al  w2  x2+2      ;   entry:=next entry;
     sl  w2 (b5)       ;   if entry>=first area entry then
     jl.     j4.       ;     goto insert parameters;
     rl  w3  x2        ;   proc:=proc(entry);
     sn  w0 (x3+a11)   ;   if name(proc)<><:sub:> then
     se  w1 (x3+a11+2) ;     goto next;
     jl.     j3.       ;
     al  w0  0         ;   else
     sn  w0 (x3+a11+4) ;     goto generate name;
     se  w0 (x3+a11+6) ;
     jl.     j2.       ;
     jl.     j1.       ;
; the name is checked to be ok.
; insert name and parameters. 
j4:  rl. w2  i2.       ; insert name:
     ds  w1  x2+a11+2  ;   insert number in name;
     rl. w1  i1.       ;   restore host;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; last number generated
i1:  0                 ; saved host
i2:  0                 ; saved sub
i3:  0                 ; last number generated
i4:  100               ;
i5:  10                ;
i6:  <:sub:>           ;
i7:  <:000:>           ;
e.


; get free buffer.
; takes the first free buffer from the message buffer pool and inserts
; it in the event queue.
;        call:         return:
; w0                   destroyed
; w1     host          unchanged
; w2                   buffer
; w3     link          main
b.i0 w.
n26: rs. w3  i0.       ; get free buffer:
     rl  w2  b8        ;   buffer:=first free in pool;
     rs  w2  b18       ;
     jl  w3  d5        ;   remove buffer;
     rs  w1  x2+4      ;   receiver(buf):=subhost;
     rs  w1  x2+6      ;   sender(buf):=subhost;
     ld  w0  -100      ;
     ds  w0  x2+10     ;
     ds  w0  x2+14     ;   insert zeroes in mess buffer;
     ds  w0  x2+18     ;
     ds  w0  x2+22     ;
     rl  w3  x1+a50    ;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; link
e.


; release buffer.
; removes a buffer from the event queue and inserts it in the
; pool of free buffers.
;        call:         return:
; w0                   unchanged
; w1                   unchanged
; w2     buffer        destroyed
; w3     link          destroyed
b.i1 w.
n27: rs. w3  i0.       ; release buffer:
     rs. w1  i1.       ;   save link, w1;
     jl  w3  d5        ;   remove buffer;
     al  w1  b8        ;   pool:=empty pool;
     jl  w3  d13       ;   insert buffer in pool;
     rl. w1  i1.       ;   restore w1;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link
i1:  0                 ; saved w1
e.

e.                     ; end of subhost driver.

e.                     ; end of host- and subhost drivers.
          
c. p101
     jl.     f4.       ; stepping stone testoutput
f4=k-2
     jl.     f5.       ; stepping stone testoutput
f5=k-2
     jl.     f6.       ; stepping stone testoutput
f6=k-2
z.                     ; end test

; fpa-subproc          common procedures
; eli, 7.8.1975

; start of subprocess-code
;*************************
w.

; table of reservations
;
; the following table is used to determine, whether the sender of a
; message has to have reserved the device or just has to be a user
; of the device. 
;
; the table holds one word for each kind of subprocesses. bit(i)=1
; means, that reservation is needed for operation=i, otherwise just user is needed.

a0= 1<23

u0= 0                  ;  first subkind used

u1=k-u0

; subkind 0: general sequential device
     0                 ;

; subkind 2: not used
     0                 ;

; subkind 4: area processes
; note, that areaprocesses are checked at normal entry
     0                 ;

; subkind 6: disc
     a0>5              ; output needs reservation

; subkind 8: typewriter
     0                 ; reservation never needed

; subkind 10: paper tape reader
     -1                ; reservation always needed

; subkind 12: paper tape punch
     -1                ; reservation always needed

; subkind 14: line printer
     -1                ; reservation always needed

; subkind 16: card reader
     -1                ; reservation always needed

; subkind 18: magnetic tape
     -1                ; reservation always needed

; subkind 20: plotter
     -1                ; reservation always needed

; subkind 22: discette
     -1                ; reservation always needed
; fpa-subproc          common procedures
; eli, 16.2.1976

;u2:                   ; see after u21.

;u3:                   ;  -    -    -
; fpa-subproc          common procedures
; eli, 4.11.1975

; procedure check and link operation
;
; checks, that the sender of the message is a user or reserver of the
; device as defined by the reservation table of the corresponding
; subkind.
;
; for messages with operation code 3 or 5 (input or output) the field
; <updated first> in the message is initialized according to <first address> in
; the message and the addresses in the message are checked.
;
; if user or reservation is ok, the message is linked to the queue of
; the subproc.
;
; note: contrary to the standard procedure 'link operation' return is
;       always made, even if other messages exist in the queue.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   undefined
; w3     link          undefined

b. i10, j10
w.

u4:  rs. w3  j0.       ; check and link operation: save link
     bl  w3  x1+p10    ;  w3:= subkind(subproc)
     rl. w0  x3+u1.    ;  w0:= reservation mask(subkind)
     rl  w2  b18       ;  w2:= current message
     bz  w3  x2+8      ;  w3:= operation(message)
     rl  w1  x2+6      ;  w1:= sender(message)
     ls  w0  x3        ;  if reservation mask(bit(operation))=1 then
     sh  w0  -1        ;
     am      g15-g14   ;  check reservation else
     jl  w3  g14       ;  check user

; access rights ok
;   w1 still holds address of internal process

     bz  w0  x2+8      ;  if operation(mes)= input or output then
     se  w0  3         ;
     sn  w0  5         ;  begin
     jl.     i0.       ;
     jl.     i1.       ;
i0:  dl  w0  x2+12     ;   make first and last address in message even
     la  w0  g50       ;
     la  w3  g50       ;
     sl  w3  (x1+a17)  ;   if first(mes)<first(internal) or
     sl  w0  (x1+a18)  ;      last(mes)>=top(internal) or
     jl      g5        ;
     sh  w0  x3-2      ;      first(mes)>last(mes) then
     jl      g5        ;   goto result 3
     ds  w0  x2+12     ;
     rs  w3  x2+22     ;   updated first(mes):= first(mes)
                       ;  end

; link message to message queue of subproc

i1:  am      (b19)     ;  w1:= addr. of message queue of subproc
     al  w1  +a54      ;
     jl  w3  d6        ;  link(w1=head,w2=elem)

c.p101 b.f1 w.         ;*****test48*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     48                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al  w0  x2        ;*
     al  w1  x2+22     ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test48*****

; return

     rl  w1  b19       ;  restore subproc address
     jl.     (j0.)     ;

j0:  0                 ; saved return

e.                     ; end of check and link operation
; fpa-subproc          common procedures
; eli, 11.2.1976

; procedure get and deliver result
;
; returns an answer with a result as defined in the result-field of mainproc
; in the following way:
;
;     result4000:= result(mainproc)+1
;     deliver result(result4000)
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   undefined
; w3     link          undefined

b. i10, j10
w.

u5:                    ; get and deliver result:
     am      (x1+a50)  ;  if function(mainproc(subproc))=
     bz  w0  +p81      ;     answer message with data then
     se  w0  v55+(:1<0:); begin
     jl.     i0.       ;   copy answer content to words g20, g21, ...
     rl  w2  b18       ;   w2:= message
     rl  w0  x2+8      ;   copy status
     rs  w0  g20       ;
     dl  w1  x2+12     ;   copy rest of answer
     ds  w1  g22       ;
     dl  w1  x2+16     ;
     ds  w1  g24       ;
     rl  w1  b19       ;  end
i0:  al  w0  1         ;  result4000:= result(mainproc(subproc))+1
     am      (x1+a50)  ;
     ba  w0  +p82      ;
c.p101 b.f1 w.         ;*****test49*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     49                ;
f0:  0                 ;
     jl.     f1.       ;
     rl  w1  g20       ;
     ds  w1  x3+2      ;
     dl  w1  g22       ;
     ds  w1  x3+6      ;
     dl  w1  g24       ;
     ds  w1  x3+10     ;
     al  w0  x3        ;
     al  w1  x3+10     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test49*****
     jl      g19       ;  goto deliver result(result4000)
                       ;  note: link unchanged.

e.                     ; end of get and deliver result
; fpa-subproc          common procedures
; eli, 7.8.1975

; procedure prepare answer
;
; prepares the variables
;   g20  <status>
;   g21  <bytes>
;   g22  <chars>
; for sending of an answer
;
; <status> is taken from the status-field of the mainproc
; <bytes> and <chars> are calculated by the fields <first address> and
; <updated first> in the message buffer and by the field <size> in
; mainproc.
;
; the separate entry, prepare after stop, initially clears the <size> and <status> fields
; of mainproc. it may be used, when the sender is stopped thus returning
; an answer corresponding to the message only.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       undefined
; w3     link          undefined

b. i10, j10
w.

u6:  rl  w1  x1+a50    ; prepare after stop:
     al  w0  0         ;  result(mainproc):= status(mainproc):=
     rs  w0  x1+p83    ;  size(mainproc):= 0
     rs  w0  x1+p84    ;
     rl  w1  b19       ;  restore current subproc
u7:  rs. w3  j0.       ; prepare answer:
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     rl  w0  x3+p83    ;
     ls  w0  12        ;
     rs  w0  g20       ;
     rl  w0  x2+22     ;  chars:= 
     ws  w0  x2+10     ;   (updated first(mess)-first(mess))/2*3
     rl  w2  0         ;
     ls  w2  -1        ;
     wa  w2  0         ;
     wa  w2  x3+p84    ;  chars:= chars+size(main)
     rs  w2  g22       ;  save chars
     al  w1  0         ;
     wd. w2  j1.       ;  bytes:= 
     se  w1  0         ;   if chars mod 3=0 then chars/3*2 else
     al  w2  x2+1      ;                         chars/3*2 +2
     ls  w2  1         ;
     rs  w2  g21       ;  save bytes

; restore w1 to subproc and return

     rl  w1  b19       ;  w1:= current subproc
     jl.     (j0.)     ;

j0:  0                 ;  saved return
j1:  3                 ;  division constant

e.                     ; end of prepare answer

; fpa-subproc          common procedures
; eli, 8.8.1975

; procedure current message address
;
; returns the content of the message address entry corresponding
; to current bufno.
;
;        call          return
; w0     
; w1     subproc       unchanged
; w2                   even entry content 
; w3     link          unchanged

b. i10, j10
w.

u8:  bl  w2  x1+p17    ; current message entry:
     am      x2        ;
     am      x2        ;  w2:= even mes.adr(current fubno*2)
     rl  w2  x1+p19    ;
     la  w2  g50       ;
     jl      x3        ; return

e.                     ; end of current message address
; fpa-subproc          common procedures
; eli, 8.8.1975

; procedure current message entry
;
; returns the absolute address of the message address entry
; corresponding to current bufno.
;
;        call          return
; w0
; w1     subproc       unchanged
; w2                   absolute address of entry
; w3     link          unchanged

b.i10, j10
w.

u9:  bl  w2  x1+p17    ; current message entry:
     am      x2        ;
     am      x2        ;  w2:= entry address(current bufno*2)
     al  w2  x1+p19    ;
     jl      x3        ;  return

e.                     ; end of current message entry
; fpa-subproc          common procedures
; eli, 8.8.1975

; procedure increase message entry
;
; increases the field current bufno to point to the next entry,
; modulo the system constant max number of buffers.
;
;        call          return
; w0                   new bufferno
; w1     subproc       unchanged
; w2                   unchanged
; w3     link          unchanged

b. i10, j10
w.

u10:                    ; increase message entry:
     bl  w0  x1+p17    ;  current bufno(subproc):=
     ba. w0  1         ;   current bufno(subproc) + 1
     sl  w0  v0        ;   modulo max bufferno
     al  w0  0         ;
     hs  w0  x1+p17    ;
     jl      x3        ;  return

e.
; fpa-subproc          common procedures
; eli, 8.8.1975

; procedure clear message entry
;
; the entry in the message address table corresponding to bufno in
; the receiver-field of mainproc is cleared. the field free bufs in
; the subproc is increased by one.
;
;         call          return
; w0                    undefined
; w1      subproc       unchanged
; w2 
; w3      link          undefined

b. i10, j10
w.

u11:  rs. w3  j0.       ; clear message entry: save link
      am      (x1+a50)  ;
      bl  w3  +p88      ; 
      al  w0  0         ;
      am      x3        ;
      am      x3        ;  message addr.(bufno(mainproc)*2):= 0
      rs  w0  x1+p19    ;
      al  w3  1         ;  free bufs(subproc):=
      ba  w3  x1+p16    ;   free bufs(subproc)+1
      hs  w3  x1+p16    ;
                        ;
      jl.     (j0.)     ;  return

j0:   0                 ; saved link

e.                      ; end of clear message entry
; fpa-subproc          common procedures
; eli, 20.1.1976

; procedure find first message
;
; if <current message> is nonzero, this value is returned.
; otherwise the procedure continues through
; <find first unprocessed message>
;
;         call          return
; w0                    undefined
; w1      subproc       unchanged
; w2                    message or 0
; w3      link          unchanged

b. i10, j10
w.

u12:                   ; find first message:
     rl  w2  x1+p13    ;  if current message(subproc)<>0 then
     se  w2  0         ;  goto check regret
     jl.     i3.       ;

; continue through u22

; fpa-subproc          common procedures
; eli, 12.8.1976

; procedure find first unprocessed message
;
; scans the messagequeue of the calling subproc and returns
; the address of the first unprocessed messagebuffer.
; 0 is returned, if no buffer is found.
;
; if a message selected has been regretted (or the sender removed)
; the message is returned and the queue scanned again.
;
; note: a processed messagebuffer has receiver(mes)<0.
;       the procedure does not change the receiver-field
;       of the message.
;       the monitor-word <current message> is set to the buffer found.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   message or 0
; w3     link          undefined


u22: rs. w3  j0.       ;  save link

; scan message queue

i0:  rl  w2  x1+a54    ; scan:
     jl.     i2.       ;  mes:= first message(subproc)
i1:  rl  w0  x2+4      ;  while receiver(mes)<0
     sl  w0  0         ;    and mes<>last message(subproc) do
     jl.     i4.       ;
     rl  w2  x2+0      ;  mes:= next(mes)
i2:  se  w2  x1+a54    ;
     jl.     i1.       ;

; no message pending in queue

     al  w2  0         ;
     jl.     (j0.)     ;  return

; w2 points to message. check regretted

i3:  rs. w3  j0.       ; check regret:  save link
i4:  rs  w2  b18       ;  current message(monitor):= mes
     rl  w0  x2+6      ;
     sl  w0  0         ;  if sender(mes)>0 then
     jl.     (j0.)     ;  return
     al  w0  0         ;
     sn  w2 (x1+p13)   ;
     rs  w0  x1+p13    ;
     al. w3  i0.       ;  no operation(mes)
     jl      g26       ;  goto scan

j0:  0                 ;

e.                     ; end of find first message
; fpa-subproc          common procedures
; eli, 8.8.1975

; procedure save and reserve message
;
; stores a message buffer address in the message entry described by
; current entry and in the current message field of the subproc.
; the message is reserved by setting the receiver-field negative,
; if it is not already so.
;
;         call          return
; w0     
; w1      subproc       unchanged
; w2      message       unchanged
; w3      link          undefined

b. i10, j10
w.

u13: ds. w3  j1.       ; save and reserve message: save message and link
     jl. w3  u9.       ;  w2:= current entry address
     rx. w2  j0.       ;  save entry:= w2
     rs. w2  (j0.)     ;  mess addr(entry):= message
     rs  w2  x1+p13    ;  current message(subproc):= message
     al  w3  -1        ;  free buffers(subproc):=
     ba  w3  x1+p16    ;    free buffers(subproc)-1
     hs  w3  x1+p16    ;
     ac  w3  (x2+4)    ;  if receiver(mes)>0 then
c.-p103
     sh  w3  0         ;
     rs  w3  x2+4      ;
z.
c.p103-1
     sl  w3  0         ;  begin
     jl.     (j1.)     ;
     rs  w3  x2+4      ;   receiver(mes):= -receiver(mes)
     am      (b1)      ;   decrease(buffer claim(current internal proc))
     bz  w3  +a19      ;
     al  w3  x3-1      ;
     am      (b1)      ;
     hs  w3  +a19      ;  end
z.
                       ;
     jl.     (j1.)     ;  return

j0:  0                 ;  saved message
j1:  0                 ;  saved link

e.                     ; end of save and reserve message
; fpa-subproc          common procedures
; eli, 8.8.1975

; procedure convert to 8-bit
;
; converts the number in w0, representing a number of 12-bit characters,
; to the corresponding number of 8-bit characters
;
;         call          return
; w0      number in 12-bits
;                       number in 8-bits
; w1   
; w2
; w3      link          undefined

b. i10, j10
w.

u14: rs. w3  j0.       ; convert to 8-bit: save link
     rl  w3  0         ;  size8:=
     ls  w3  -1        ;    size12*3/2
     wa  w0  6         ;
     jl.     (j0.)     ;  return

j0:  0                 ; saved link

e.                     ; end of convert to 8-bit
; fpa-subproc          common procedures
; eli, 15.1.1976

; procedure convert to 12-bit
;
; converts the number in w0, representing a number of 8-bit characters,
; to the corresponding number of 12-bit characters.
;
;          call          return
; w0       number in 8-bit
;                        number in 12-bit
; w1    
; w2
; w3     link          undefined

b. i10, j10
w.

u15: rs. w3  j0.       ; convert to 12-bit: save link
     al  w3  0         ;  prepare division
     wd. w0  j1.       ;  size12:= size8/3*2
     se  w3  0         ;  if size8 mod 3<>0 then
     ba. w0  1         ;  size12:= size12+2
     ls  w0  1         ;
c.-p103
     se  w3  0         ;  convert size8 mod 3 to mainproc value
     ac  w3  x3-3      ;
z.
     jl.     (j0.)     ;  return

j0:  0                 ;  saved link
j1:  3                 ;  8-bit characters per word

e.                     ; end of convert to 12-bit

; fpa-subproc          common procedures
; eli, 19.8.1975

; procedure prepare addresses
;
; initializes the fields <first addr>, <data size> and <size>
; in the mainproc sender table corresponding to the next part
; of a message to be transmitted.
; if a block of size 0 is encountered, the data-bit in the func-
; tion-field is cleared.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       unchanged
; w3     link          undefined

b. i10, j10
w.

u16: rs. w3  j0.       ; prepare addresses: save link
     al  w3  2         ;  saved size:=
     wa  w3  x2+12     ;   last addr(mes)-updated first(mes)
     ws  w3  x2+22     ;   +2
     rl  w0  6         ;  size:= saved size

; test for maximum size exceeded

     sl  w0  (x1+p18)  ;  if size>maxsize(subproc) then
     rl  w0  x1+p18    ;     size:= maxsize(subproc)
     sl. w0  (j1.)     ;  if size>maxsize(datanet) then
     rl. w0  j1.       ;     size:= maxsize(datanet)
     se  w0  (6)       ;  if size= saved size then
     jl.     i0.       ;     comment: last block of message
     al  w3  0         ;     current message(subproc):= 0
     rs  w3  x1+p13    ;

; set first, last and size in mainproc

i0:  rl  w1  x1+a50    ;  main:= mainproc(subproc)
     rl  w3  x2+22     ;  first:= first(main):= updated first(mes)
     rs  w3  x1+p65    ;
c.-p103
     wa  w3  0         ;
     al  w3  x3-2      ;   last(main):= first + size - 2
     rs  w3  x1+p66    ;
z.
     se  w0  0         ;  if size=0 then
     jl.     i1.       ;
     bl  w3  x1+p61    ;    databit(function(main)):= 0
     la  w3  g50       ;
     hs  w3  x1+p61    ;
i1:  jl. w3  u14.      ;  header size(main):= data size(main):=
     rs  w0  x1+p64    ;    convert to 8-bit(size)
c.p103-1
     rs  w0  x1+p66    ;
z.
     rs  w0  x2+20     ;  expected size(mes):= size(main)

; return

     rl  w1  b19       ;  restore subproc addr
     jl.     (j0.)     ; 

j0:  0                 ; saved link
j1:  v2                ; datanet max buffer size

e.                     ; end of prepare addresses

; fpa-subproc          common procedures
; eli, 17.9.1975

; procedure test and decrease stop count
;
; upon entry w2 holds a number of an entry in the message table.
; if the entry points to a message and the stop count of
; the sender of the corresponding message has been increased (i.e.
; message entry is odd) then the stop count of the sender is decreased
; and the flag in the message table cleared.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     messageno     undefined
; w3     link          undefined

b. i10, j10
w.
u18:                   ; test and decrease stop count:
     am      x2        ;  mes:= message table(messageno*2)
     am      x2        ;
     al  w2  x1+p19    ;
     rl  w0  x2        ;
     sl  w0  (b8+4)    ;  if not possible messageaddress or
     so  w0  2.1       ;     not stop count increased(mes) then 
     jl      x3        ;  return
     rs. w3  j0.       ;  save return
     la  w0  g50       ;  stop count increased(mes):= false
     rs  w0  x2        ;
     rx  w0  b18       ;  current message(monitor):= mes
     rs. w0  j1.       ;  save old current message(monitor)
     jl  w3  g32       ;  decrease stop count
     rl  w1  b19       ;  restore subproc
     rl. w2  j1.       ;  restore current message(monitor)
     rs  w2  b18       ;

     jl.     (j0.)     ;  return

j0:  0                 ;  saved link
j1:  0                 ;  saved current message(monitor)

e.                     ; end of test and decrease stop count
; fpa-subproc          common procedures
; eli, 17.9.1975

; procedure clear subproc message queue
;
; called from hostproc, when a transmission line error is detected or a
; master clear received.
;
; all messages in the queue of the subproc (processed as well as unprocessed)
; are returned with result=4 (receiver malfunction)
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   undefined
; w3     link          undefined

b. i10, j10
w.
u19:                   ; clear subproc message queue:
v100= u19              ;
     rs. w3  j0.       ;  save link
     rl  w2  b18       ;
     rs. w2  j2.       ;   save curr mess;
     al  w2  0         ;  for w2:= all entries in message table do
c.p101 b.f1 w.         ;******test50*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     50                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1        ;   testrecord:=
     al  w1  x1+p19+16 ;     process description;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test50*****
i2:  rs. w2  j1.       ;  
     jl. w3  u18.      ;   test and decrease stopcount(w2)
     rl. w2  j1.       ;
     al  w0  0         ;
     am      x2        ;  if message table(w2)<>0 then
     am      x2        ;  begin
     rx  w0  x1+p19    ;
     sn  w0  0         ;
     jl.     i3.       ;
     al  w3  1         ;   free bufs(subproc):= free bufs(subproc)+1
     ba  w3  x1+p16    ;
     hs  w3  x1+p16    ;
i3:  al  w2  x2+1      ;
     rl  w0  x1+a10    ;   if kind(sub)=hostproc kind then
     sn  w0  p111      ;     max entries:=v3
     am      v3-v0     ;   max entries:=v0;
     se  w2  v0        ;
     jl.     i2.       ;  end
     jl.     i1.       ;

; scan message queue and return answers

i0:  rs  w2  b18       ;  for mes:= first message(subproc)
     al  w0  4         ;      while mes<>last message(subproc) do
     jl  w3  g19       ;
     rl  w1  b19       ;   deliver result(4)
i1:  rl  w2  x1+a54    ;
     se  w2  x1+a54    ;
     jl.     i0.       ;
     al  w0  0         ;  internal state(subproc):= 0
     rs  w0  x1+p12    ;
     rs  w0  x1+p13    ;  current message(subproc):= 0
     hs  w0  x1+p17    ;  current bufno(subproc):= 0
     rl. w2  j2.       ;
     rs  w2  b18       ;   restore curr mess;

     jl.     (j0.)     ;  return

j0:  0                 ;  saved link
j1:  0                 ;  saved messageno
j2:  0                 ;   saved curr mess

e.                     ; end of clear subproc message queue
; fpa-subproc          common procedures
; eli, 15.1.1976

; procedure test answer attention
;
; called when the subproc is ready for sending a header.
;
; if the <answer attention> flag is set in the statefield of the subproc,
; mainproc will be initiated to transmit the answer. <bufno> from the
; attention message received has previously been saved in the rightmost 8
; bits of <state>.
; if an attention answer is pending the procedure will return to mainproc.
;
;        call          return
;  w0                  undefined
;  w1    subproc       unchanged
;  w2                  unchanged
;  w3    link          undefined

b. i10, j10
w.

u20:                   ; test answer attention:
     rl  w0  x1+p12    ;  if answer attention(state(subproc))=0 then
     so  w0  v71       ;  return
     jl      x3        ;
                       ;
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     jl. w3  u25.      ;  set linkparams
     al  w0  v59       ;  function(main):= answer attention
     hs  w0  x3+p61    ;
     rl  w0  x1+p12    ;  bufno(main):= rightmost 8 bits
     la  w0  g53       ;   (state(subproc))
     hs  w0  x3+p68    ;
                       ;
     jl      (b101)    ;  goto mainproc return

e.                     ; end of test answer attention
; fpa-subproc          common procedures
; eli, 11.2.1976

; procedure test and increase stop count
;
; increases the stop count of the sender of a message, if it has
; not already been increased. the message must be present in the
; message table and the address in the table must bee odd if stop
; count has been increased.
;
;        call          return
;  w0                  undefined
;  w1    subproc       unchanged
;  w2    message       see below
;  w3    link          undefined
;
; if stop count could not bee increased, because the sender has been
; stopped then return will be made to <link> and the message has
; been returned (w2 is undefined).
;
; otherwise return to <link+2> (w2 is unchanged).

b. i10, j10
w.

u21:                   ; test and increase stop count:
     rs. w3  j0.       ;  save link
     al  w3  x1+p19    ;  search message table for message
     jl.     i1.       ;


i0:  al  w3  x3+2      ;
i1:  rl  w0  x3        ;  w0:= even message(message table) 
     la  w0  g50       ;
     se  w0  x2        ;
     jl.     i0.       ;

; w3 points to entry. w0 holds even message address

     lo  w0  g63       ;  set odd value in message table
     rx  w0  x3        ;
     sz  w0  2.1       ;  if stop count already increased then
     jl.     i2.       ;  goto ok-return

; examine state of sender before increase

     rs. w3  j1.       ;  save entry
     jl  w3  g34       ;  exam sender
     jl.     i3.       ; stopped: goto stop-return
     jl  w3  g31       ; ok: increase stop count

; return to <link+2>

i2:  rl. w3  j0.       ; ok-return:
     jl      x3+2      ;

; stop count could not be increased. deliver answer

i3:  al  w0  0         ;  message entry:= 0
     rs. w0  (j1.)     ;  if mes=current message(subproc) then
     sn  w2  (x1+p13)  ;  current message(subproc):= 0
     rs  w0  x1+p13    ;
     al  w3  1         ;
     ba  w3  x1+p16    ;
     hs  w3  x1+p16    ;  free buffers:= free buffers+1
c.p101 b.f1 w.         ;*****test51*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     51                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al  w0  x1+p11    ;*
     al  w1  x1+p19+14 ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test51*****
     jl. w3  u6.       ;  prepare answer after stop
     jl  w3  g18       ;  deliver  result(1)
     jl.     (j0.)     ;  goto <link>

j0:  0                 ;  saved link
j1:  0                 ;  saved entry

e.                     ; end of test and increase stop count
; fpa-subproc          common procedures
; eli, 8.6.1977

; procedure set linkparams
;
; copies the fields devhost linkno, jobhost linkno,
; devhost host-id, devhost net-id and devhost
; home-reg to the mainproc parameters.
;
; also copies the bufferno of the link and sets the
; monitor address code to 'no check'.
;
;        call          return
;  w0                  undefined
;  w1    subproc       unchanged
;  w2                  unchanged
;  w3    link          mainproc

b. i10, j10
w.

u25:                   ; set linkparams:
     rs. w3  j0.       ;  save link
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     bz  w0  x1+p11    ;  receiver linkno(main):=
     hs  w0  x3+p69    ;   devhost linkno(subproc)
     bz  w0  x1+p9     ;  sender linkno(main):=
     hs  w0  x3+p78    ;   jobhost linkno(subproc)
     bz  w0  x1+p7     ;  receiver net-id(main):=
     hs  w0  x3+p301   ;   devhost net-id(subproc)
     bz  w0  x1+p6     ;  receiver home-reg(main):=
     hs  w0  x3+p302   ;   devhost home-reg(subproc)
     rl  w0  x1+p5     ;  receiver host-id(main):=
     rs  w0  x3+p303   ;   devhost host-id(subproc)
c.p103-1
     al  w0  8         ;  address code(main):= dirty
     hs  w0  x3+p72    ;
z.
     bz  w0  x1+p17    ;  bufno(main):= bufno(subproc)
     hs  w0  x3+p68    ;
                       ;
     jl.     (j0.)     ;  goto return

j0:  0                 ; saved link

e.                     ; end of set linkparams
; fpa-subproc          common procedures
; eli, 8.6.1977

; procedure testlink
;
; tests, that the mainproc parameters sender linkno, sender host-id
; and sender net-id are equal to the parameters devhost linkno,
; devhost host-id and devhost net-id in the subproc.
;
; if not equal, return will be made to link+0, otherwise
; to link+2.
;
;        call          return
;  w0                  undefined
;  w1    subproc       unchanged
;  w2                  mainproc
;  w3    link          unchanged

b. i10, j10
w.

u23:                   ; testlink:
     rl  w2  x1+a50    ;  main:= mainproc(subproc)
     bl  w0  x2+p98    ;  if sender linkno(main)<>
     bs  w0  x1+p11    ;     devhost linkno(subproc) then
     se  w0  0         ;  goto link+0
     jl      x3+0      ;
     rl  w0  x2+p323   ;  if sender host-id(main)<>
     se  w0  (x1+p5)   ;     devhost host-id(subproc) then
     jl      x3+0      ;  goto link+0
     bl  w0  x2+p321   ;  if sender net-id(main)<>
     bs  w0  x1+p7     ;     devhost net-id(subproc) then
;    se  w0  0         ;  goto link+0
;    jl      x3+0      ;
     jl      x3+2      ;  goto link+2

e.                     ; end of testlink
; fpa-subproc          common procedures
; eli, 8.6.1977

; procedure reject
;
; sets the internal status of mainproc to 'reject'
; and jumps to testmore
;
;        call          no return
;  w0
;  w1    subproc
;  w2
;  w3

b. i10, j10
w.

u24:                   ; reject:
     al  w0  p163      ;  internal status(mainproc(subproc):=
     am      (x1+a50)  ;  reject
     hs  w0  +p80      ;
     jl.     u2.       ;  goto testmore

e.                     ; end of reject
; fpa-subproc          common procedures
; eli, 7.8.1975

; testmore
;
; entered, when the subproc-state should be tested for more messages to
; process.
;
; if the state of the subproc is free, and more messages to process exist
; the subproc is linked to the mainproc.
;
; return is made through the common return.
;
; upon entry:
;
;  w0    
;  w1
;  w2   
;  w3
;  b19    subproc

b.i10, j10
w.

u2:                    ; testmore:
     rl  w1  b19       ;  get current subproc
c.p101 b.f1 w.         ;*****test52*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     52                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1        ;   testrecord:=  
     al  w1  x1+p19+16 ;     process description;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test52*****
     rl  w0  x1+p14    ;  if in mainproc queue then
     se  w0  x1+p14    ;  
     jl      (b101)    ;  return

; test answers to transmit

     rl  w0  x1+p12    ;
c.p101 b.f1 w.         ;*****test53*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     53                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al  w0  x3        ;*
     al  w1  x3-2      ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test53*****
     sz  w0  v71       ;  if answer att<>0 then
     jl.     i0.       ;  goto link subproc

; test message entry free and number of buffers free

     jl. w3  u8.       ;  if mess.addr.(cur.entry)<>0
     bl  w0  x1+p16    ;
c.p101 b.f1 w.         ;*****test54*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     54                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al  w0  x3        ;*
     al  w1  x3-2      ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test54*****
     sn  w2  0         ;  or bufs free=0 then
     sn  w0  0         ;
     jl      (b101)    ;  goto return

; test for a current message or more messages to process

     rl  w0  x1+p12    ;
     sz  w0  v70       ;  if blocked(subproc) then
     jl      (b101)    ;  goto mainproc return
     sz  w0  v72       ;  if pending messages(subproc)<>0 then
     jl.     i0.       ;  goto link subproc
     jl. w3  u12.      ;  if next pending=0 then
c.p101 b.f1 w.         ;*****test55*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     55                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al  w0  x3        ;*
     al  w1  x3-2      ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test55*****
     sn  w2  0         ;
     jl      (b101)    ;  goto return

; a message or answer is pending
; link subproc to the corresponding mainproc
;
; note: the buffer is not reserved for the subproc and the bufferaddress
;       not saved until processing actually starts.

i0:                    ; link subproc:
     al  w2  x1+p14    ;  elem:= queue elem(subproc)
     am      (x1+a50)  ;  head:= queue head(mainproc(subproc))
     al  w1  +p14      ;
     jl  w3  d6        ;  link(head,elem)

; mainproc will later activate the subproc

     jl    (b101)      ;  goto return

e.                     ; end of testmore
; fpa-subproc          common procedures
; eli, 7.8.1975

; procedure no block
;
; signals a 'nothing to do' status to mainproc,
; clears busy and returns to mainproc
;
;        call          no return
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

u3:  al  w0  p164      ; no block:
     am      (x1+a50)  ;  internal state(mainproc):=
     hs  w0  +p60      ;    'nothing to do' (i.e. regretted)
     jl.     u2.       ;  goto testmore

e.                     ; end of no block

; fpa-subproc          stepping stones
; eli, 77.06.14

c. p101

     jl.     f4.       ;
f4=k-2

     jl.     f5.       ;
f5=k-2

     jl.     f6.       ;
f6=k-2

z.

     jl.     u4.       ;
u4=k-2

     jl.     u8.       ;
u8=k-2

     jl.     u12.      ;
u12=k-2

     jl.     u15.      ;
u15=k-2
; fpa-subproc          common procedures
; eli, 11.2.1976

; procedure prepare transfer
;
; saves the message address for the subproc and then
; prepares transmission of a header (and maybe a datablock)
; depending on the operation-field in the message.
; finally the standard parameters in mainproc corresponding to
; the subproc are set.
;
; note, that only the operations <input>, <output> or <message>
;       may be handled.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       unchanged
; w3     link          undefined

b. i10, j10
w.

u30:                   ; prepare transfer:
     rs. w3  j0.       ;  save link
     jl. w3  u13.      ;  save and reserve message
     al. w3  i0.       ;  link:= after prepare

; switch to procedure, corresponding to operation

     bl  w0  x2+8      ;  op:= operation(mes)
     sn  w0  3         ;  if op=input then
     jl.     u31.      ;     goto prepare input
     sn  w0  5         ;  if op=output then
     jl.     u32.      ;     goto prepare output
     jl.     u33.      ;  goto prepare message

; return is made to here from all subroutine calls.
; set rest of parameters

i0:  rl  w3  x1+a50    ;  main:= mainproc(subproc)
     bz  w0  x1+a56+1  ;  s:= initialize state(subproc)
     se  w0  1         ;  state(main):= if s=1 then s else 0
     al  w0  0         ;
     hs  w0  x3+p62    ;
     al  w0  0         ;  initialize state(subproc):=0
     hs  w0  x1+a56+1  ;
     bz  w0  x2+9      ;  mode(main):= mode(mes)
     rs  w0  x3+p63    ;
     jl. w3  u25.      ;  set linkparams
     rl  w0  x1+p13    ;   if current message(subproc)<>0 then
     sn  w0  0         ;     blocked(subproc):=true;
     jl.     i1.       ;
     al  w0  v70       ;
     lo  w0  x1+p12    ;
     rs  w0  x1+p12    ;
i1:                    ;
c.p101 b.f1 w.         ;*****test56*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     56                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al  w0  x2        ;*
     al  w1  x2+22     ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test56*****

; return

     jl.     (j0.)     ;

j0:  0                 ;  saved link

e.                     ; end of prepare transfer
; fpa-subproc          common procedures
; eli, 19.8.1975

; procedure prepare input
;
; prepares transmission of a header corresponding to an input-
; message. the <size>-field of the header shows how many characters
; should be input.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       unchanged
; w3     link          undefined

b. i10, j10
w.
u31:                   ; prepare input:
     rs. w3  j0.       ;  save link
     jl. w3  u16.      ;  prepare addresses
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     al  w0  v50       ;  function(main):= input
     hs  w0  x3+p61    ;
     al  w0  0         ;  data size(main):= 0
     rs  w0  x3+p66    ;
     jl.     (j0.)     ;  goto link

j0:  0                 ; saved link

e.                     ; end of prepare input
; fpa-subproc          common procedures
; eli, 11.2.1976

; procedure prepare output
;
; prepares the transmission of a header corresponding to an
; output-message. the addresses in the sender table of mainproc
; are initialized corresponding to a datablock, which is to
; be transmitted following the header.
; if the sender of the message is stopped, an answer is 
; generated showing the number of bytes and characters output
; until now.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       unchanged
; w3     link          undefined

b. i10, j10
w.

u32: rs. w3  j0.       ; prepare output: save link

; examine state of sender

     jl. w3  u21.      ;  test and increase stop count
     jl.     u3.       ; stopped: goto no block

; sender still running

     al  w0  v52+(:1<0:); function(mainproc(subproc)):=
     am      (x1+a50)  ;   output+databit
     hs  w0  +p61      ;
     jl. w3  u16.      ;  prepare addresses
     jl.     (j0.)     ;  goto link

j0:  0                 ;  saved link

e.                     ; end of prepare output
; fpa-subproc          common procedures
; eli, 19.8.1975

; procedure prepare message
;
; prepares transmission of a header , followed by the content of
; the messagebuffer (only the user part is transmitted).
; the field <current message> in the subproc is cleared.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       unchanged
; w3     link          mainproc

b. i10, j10
w.

u33: rs. w3  j0.       ; prepare message: save link
     al  w0  0         ;  current message(subproc):= 0
     rs  w0  x1+p13    ;
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     al  w0  x2+8      ;  first(main):= first user addr(mes)
     rs  w0  x3+p65    ;
     al  w0  (:22-8+2:)/2*3; header size(main):= data size(main):=
     rs  w0  x3+p64    ;    size of user part(mes)
c.-p103
     al  w0  x2+22     ;
z.
     rs  w0  x3+p66    ;
     al  w0  v54o.1    ; function(mainproc):= message+databit
     hs  w0  x3+p61    ;

; return

     jl.     (j0.)     ;  

j0:  0                 ; saved link

e.                     ; end of prepare message
; fpa-subproc          common procedures
; eli, 11.2.1976

; procedure test header and data transmitted
;
; tests the result of transmission of a header and (maybe)
; a datablock.
; if the <stop count increased>-flag is set, the stop count
; of the sender of current message is decreased.
; if a transmission error has occured, the message is returned
; with result=4 (receiver malfunction) and the <current message>-
; field cleared. return will then be made to <link+0>.
;
; if no error has occured, <current bufno> is
; increased and return made to <link+2>.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   undefined
; w3     link          undefined

b. i10, j10
w.

u40:                   ; test header and data transmitted:
     rs. w3  j0.       ;  save link
     rl  w3  x1+a50    ;  if function type(main(subproc))=answer then
     bz  w0  x3+p61    ;
     sz  w0  2.10      ;
     jl.     i1.       ;  goto after answer attention
     jl. w3  u8.       ;  <current buffer>:= w2:=
     rs  w2  b18       ;  message
     bl  w2  x1+p17    ;  get messageno
     sz  w0  2.1       ;  if databit(function)=1 then
     jl. w3  u18.      ;  test and decrease stop count
     rl  w2  b18       ;

; test transmission state

     am      (x1+a50)  ;  if internal state(mainproc(subproc))<>0 then
     bl  w0  +p60      ;  begin
     sn  w0  0         ;
     jl.     i0.       ;  

; transmission trouble

     sl  w2  (b8+4)    ;  if message addr>=first message then
     jl.     +4        ;  begin
     jl.     i2.       ;
                       ;
     se  w0  p161      ;   if state<>1 then
     al  w2  0         ;   mes:= 0
     rs  w2  x1+p13    ;   comment: state=1 after wait;
     al  w0  4         ;   current message(subproc):= mes
     sn  w2  0         ;   if mes=0 then
     jl  w3  g19       ;   deliver result(4)
i2:  al  w0  -1-v70    ;  end
     la  w0  x1+p12    ;  blocked(subproc):= false
     rs  w0  x1+p12    ;
c.p101 b. f1 w.        ;*****test57*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     57                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     rl  w2  b18       ;*
     al  w0  x2        ;*
     al  w1  x2+22     ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test57*****
     al  w0  0         ;
     jl. w3  u9.       ;   message addr(current entry):= 0 
     rs  w0  x2        ;
     al  w0  1         ;   increase(free buffers(subproc))
     ba  w0  x1+p16    ;
     hs  w0  x1+p16    ;
     jl.     (j0.)     ;   goto link+0
                       ;  end

; transmission ok.

i0:                    ;
c.p101 b.f1 w.         ;*****test58*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     58                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     rs  w2  x3        ;*
     rl  w2  x1+p13    ;*
     rs  w2  x3+2      ;*
     al  w0  x3        ;*
     al  w1  x3+2      ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test58*****
     jl. w3  u10.      ;  increase(current entry(subproc))

; return

     jl.     i3.       ;  goto link+2

; answer attention has been transmitted

i1:  bz  w3  x3+p60    ; after answer attention:
c.p101 b.f1 w.         ;*****test59*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     59                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     rs  w0  x3        ;*
     al  w0  x3        ;*
     al  w1  x3        ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test59*****
     al  w0  -1-v71    ;  if internal state(main)=0 then
     la  w0  x1+p12    ;
     sn  w3  0         ;
     rs  w0  x1+p12    ;  answer attention flag(subproc):= false
i3:  rl. w3  j0.       ;  goto link+2
     jl      x3+2      ;

j0:  0                 ;  saved link

e.                     ; end of test header and data transmitted
; fpa-subproc          common procedures
; eli, 15.1.1976

; procedure test answer header
;
; called when a header, which is going to be followed by a datablock has
; been received.
; in the current version only answers to previously transmitted messages
; may be handled.
; functions may be <answer input> or <answer message>.
; the bufno in the answer is used to find the message table entry.
;   depending on the value in the entry, the following is performed:
;
; message entry:
;
;   0       the message has been returned due to line errors. a reject
;           status is returned on the communication line. return
;           will be made to testmore.
;   impossible message address: signals a special function for the
;           subproc. return to <link+2>.
;   normal message address: procedure corresponding to function is
;           activated. if the datablock can be received return is
;           made to mainproc. otherwise a skip-status is signalled
;           and return made to <link>.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   undefined
; w3     link          undefined

b.i10, j10
w.

u50:                   ; test header:
     rs. w3  j0.       ;  save link
     jl. w3  u23.      ;  testlink
     jl.     u24.      ; error: goto reject
     rl. w3  j0.       ;  restore link
     al  w0  p160      ;
     hs  w0  x2+p80    ;  skip(main):= false
     bz  w0  x2+p81    ;  func:= function(main)
     bz  w2  x2+p88    ;  mes:= even message table(bufno(main))
     am      x2        ;
     am      x2        ;
     rl  w2  x1+p19    ;
c.p101 b.f1 w.         ;*****test60*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     60                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al  w0  x2        ;*
     al  w1  x2+22     ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test60*****
     la  w2  g50       ;
     sl  w2  (b8+4)    ;  if mes<first message then
     jl.     i0.       ;  begin
     sn  w2  0         ;  if mes=0 then
     jl.     u24.      ;  goto reject
c.p101 b.f1 w.         ;*****test61*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;*
     61                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al  w0  x1+p19    ;*
     al  w1  x1+p19+14 ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test61*****
     jl      x3+2      ;   goto <link+2>
                       ;  end
i0:  rs  w2  b18       ;  current message(monitor):= mes
     am      (x1+a50)  ;  if local function(rec)=
     bz  w3  +p99      ;     rejected packet then
     se  w3  3         ;  begin comment: deliver answer malfunction;
     jl.     i1.       ;
     am      (x1+a50)  ;   w2:= bufno(rec)
     bz  w2  +p88      ;
     jl. w3  u18.      ;   test and decrease stopcount
     jl. w3  u11.      ;   clear message entry
     al  w0  4         ;
     jl  w3  g19       ;   deliver result(4)
     al  w0  p162      ;   internal status(main):= skip
     am      (x1+a50)  ;
     hs  w0  +p80      ;
     jl.     u2.       ;   goto testmore

; switch to action

i1:  rl. w3  j0.       ;  end
     sn  w0  v51+(:1<0:);  if function= <answer input with data> then
     jl.     u51.      ;     goto test answer input
     jl.     u53.      ;   goto test answer message

j0:  0                 ; saved link

e.                     ; end of test answer header

; fpa-subproc          common procedures
; eli, 11.2.1976

; procedure test answer input header
;
; called, when a header with function=<answer input with data> has been
; received.
; the state of the receiving process
; is checked.  if it is still running, the mainproc parameters
; are initialized and the procedure returns to mainproc.
;
; if the receiver is stopped an answer is returned and a skip-status signalled
; to mainproc.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       undefined
; w3     link          undefined

b. i10, j10
w.

u51:                   ; test answer input header:
     rs. w3  j0.       ;  save link

; examine state of receiving process

     jl. w3  u21.      ;  test and increase stop count
     jl.     i0.       ; stopped: goto skip 

; sender still running

     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     rl  w0  x2+22     ;  first(main):= updated first(mes)
     rs  w0  x3+p85    ;
     rl  w0  x3+p84    ;  
c.-p103
     jl. w3  u15.      ;   size12:= convert to 12-bit(size8)
     wa  w0  x2+22     ;   last(main):= updated first(mess)
     am      (0)       ;     + size12
     al  w0  -2        ;     - 2
     am      (x1+a50)  ;
     rs  w0  +p86      ;
     am      (x1+a50)  ;
     hs  w3  +p87      ;   set charracter count in last word
z.
c.p103-1
     rs  w0  x3+p86    ;  data size(main):= header size(main)
     al  w0  8         ;  address code(main):= dirty
     hs  w0  x3+p92    ;
z.


; return to mainproc, which will then receive the datablock

     jl      (b101)    ;  goto mainproc return

; receiver of databuffer stopped

i0:  al  w0  p162      ; skip:  signal skip-status to mainproc
     am      (x1+a50)  ;
     hs  w0  +p80      ;

; return

     jl.     (j0.)     ;

j0:  0                 ;  saved link

e.                     ; end of test answer input header
; fpa-subproc          common procedures
; eli, 15.1.1976

; procedure test answer message header
;
; called when a header with function=<answer message with data> has been 
; received.
; the parameters in mainproc are initiated to receive the answer.
; return will always be made to mainproc.
;
; note, that it is not necessary to check the running status
;       of the receiver, as the datablock is received directly
;       in the messagebuffer area in the monitor.
;
;        call          no return
; w0
; w1     subproc
; w2     message
; w3

b. i10, j10
w.

u53:                   ; test answer message header: 
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     al  w0  x2+8      ;  first(main):= first user word(mes)
     rs  w0  x3+p85    ;  
c.-p103
     al  w0  x2+22     ;   last(main):= last user word(mes)
     rs  w0  x3+p86    ;
     al  w0  0         ;   character count in last word:= 0
     hs  w0  x3+p87    ;   (i.e. 3 characters)
z.
c.p103-1
     al  w0  (:22-8+2:)/2*3;  data size(main):=
     rs  w0  x3+p86    ;  size of user part(mes)
     al  w0  8         ;  address code(main):= dirty
     hs  w0  x3+p92    ;
z.
     jl      (b101)    ;  return to mainproc

e.                     ; end of test answer message header

; fpa-subproc          common procedures
; eli, 11.2.1976

; procedure test answer data received
;
; a header without a datablock, or the datablock following a header has
; been received.
; if stop count has been increased (answer input) it is decreased.
;
; if the function field of the header corresponds to a message received
; (attention) return will be made to <link+2>.
;
; if the message table of the entry corresponding to the bufno in the
; answer does not describe a message (value to small) return will be made
; to <link+4>. in this case w2 will hold the content of the message table entry.
;
; otherwise the procedure, corresponding to the mainproc <function>-
; field is activated and return made to <link>.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   undefined (see above for return to <link+4>
; w3     link          undefined

b. i10, j10
w.

u60:                   ; test answer data received:
     rl  w2  x1+a50    ;  if function(mainproc(subproc))=attention then
     bz  w0  x2+p81    ;
     sn  w0  v58       ;
     jl.     u64.      ;  goto attention received.
                       ;  note: link unchanged. will return to <link+2>
     rs. w3  j0.       ;  save link
     sz  w0  2.1       ;  if no data then
     jl.     i2.       ;  begin
     jl. w3  u23.      ;   testlink
     jl.     u24.      ; error: goto reject
                       ;  end
i2:  bz  w2  x2+p88    ;  mes:= even message addr(bufno(mainproc(subproc)))
     am      x2        ;
     am      x2        ;
     rl  w3  x1+p19    ;
     la  w3  g50       ;
     sn  w3  0         ;  if mes=0 then
     jl.     u24.      ;  goto reject
     rs  w3  b18       ;  current message(monitor):= mes
     jl. w3  u18.      ;  test and decrease stopcount(w2=messageno)
     rl  w2  b18       ;  restore message
     jl. w3  u11.      ;  clear message entry
     al  w0  -1-v70    ;   blocked(subproc):=false;
     la  w0  x1+p12    ;
     rs  w0  x1+p12    ;
     sl  w2  (b8+4)    ;  if mes<first message buffer then
     jl.     i0.       ;
     rl. w3  j0.       ;   goto <link+4>
     jl      x3+4      ;  

; switch to action
i0:  rl  w3  x1+a50    ;
     bz  w0  x3+p99    ;  if local function(rec)=
     se  w0  3         ;     rejected packet then
     jl.     i1.       ;  begin
     al  w0  4         ;
     jl  w3  g19       ;   deliver result(4)
     jl.     u2.       ;   goto testmore
i1:                    ;  end
     bz  w0  x3+p81    ;  w0:= function(mainproc(subproc))
     la  w0  g50       ;  remove databit
     rl. w3  j0.       ;  link:= saved link
     sn  w0  v51       ;  if function=<answer input> then
     jl.     u61.      ;    goto answer input data received 
     sn  w0  v53       ;  if function=<answer output> then
     jl.     u62.      ;    goto test answer output header
     jl.     u63.      ;  goto test answer message data

j0:  0                 ;  saved link

e.                     ; end of test answer data received

; fpa-subproc          common procedures
; eli, 15.1.1976

; procedure answer input data received
;
; called, when the datablock following a header with <function>=
; <answer input (with or without data)> has been received.
;
; if the message is not current message, if a result- or status error
; is detected or if less than wanted is input, an answer with result=1
; is generated. otherwise the next block may be input.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       unchanged
; w3     link          undefined

b. i10, j10
w.

u61:                   ; answer input data received:
     rs. w3  j0.       ;  save link
     se  w2  (x1+p13)  ;  if mes=current message(subproc) then
     jl.     i1.       ;  begin
     rl  w3  x1+a50    ;   main:= mainproc(subproc)
     rl  w0  x3+p84    ;   if size(main)=expected size(mes)
     bl  w3  x3+p82    ;      and
     am      (x1+a50)  ;
     wa  w3  +p83      ;
     sn  w3  0         ;
     se  w0  (x2+20)   ;      result(main)=status(main)=0 then
     jl.     i0.       ;   begin
c.-p103
     rl  w3  x1+a50    ;
     rl  w3  x3+p86    ;   updated first(mes):= last addr(main) + 2
     al  w3  x3+2      ;
     rs  w3  x2+22     ;
z.
c.p103-1
     jl. w3  u15.      ;    updated first(mes):=
     wa  w0  x2+22     ;      updated first(mes)+ convert to 12-bit(header size(main))
     rs  w0  x2+22     ;
z.
     jl.     (j0.)     ;    goto return
                       ;   end result ok

; after some error in current message

i0:  al  w0  0         ;   current message(subproc):= 0
     rs  w0  x1+p13    ;  end current message

; not current message
                       ;  else
i1:  jl. w3  u7.       ;  prepare answer
     rl. w3  j0.       ;  link:= saved link
     jl.     u5.       ;  goto get and deliver result

j0:  0                 ;  saved link

e.                     ; end of answer input data received
; fpa-subproc          common procedures
; eli, 15.1.1976

; procedure test answer output 
;
; test the parameters in a header corresponding to function
; =answer output.
; if the following conditions:
;
;   -the corresponding message is <current message>
;   -the result is ok (=0)
;   -the status is ok (=0)
;   -the whole block has been output
; a transfer of next part is prepared.
;
; otherwise an answer is generated
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       undefined
; w3     link          undefined

b. i10,j10
w.
u62:                   ; test answer output header:
     rs. w3  j0.       ;  save link
     se  w2  (x1+p13)  ;  if mes=current message(subproc) then
     jl.     i1.       ;  begin
     rl  w3  x1+a50    ;   main:= mainproc(subproc)
     rl  w0  x3+p84    ;   if size(main)=expected size(mes)
     bl  w3  x3+p82    ;     and
     am      (x1+a50)  ;
     wa  w3  +p83      ;
c.p101 b.f1 w.         ;*****test62*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     62                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     rs  w0  x3        ;*
     rs  w1  x3+2      ;*
     rs  w2  x3+4      ;*
     rl. w0  f0.       ;*
     rs  w0  x3+6      ;*
     al  w0  x3        ;*
     al  w1  x3+6      ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test62*****
     sn  w3  0         ;
     se  w0  (x2+20)   ;      result(main)=status(main)=0 then
     jl.     i0.       ;   begin
     jl. w3  u15.      ;    updated first(mes):=
     wa  w0  x2+22     ;      updated first(mes)+convert to 12-bit(size(main)
     rs  w0  x2+22     ;
     jl.     (j0.)     ;    goto return
                       ;   end result ok

; after an error in current message

i0:  al  w3  0         ;   current message(subproc):= 0
     rs  w3  x1+p13    ;  end current message

; not current message
i1:                    ;
c.p101 b.f1 w.         ;*****test63*****
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     63                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al  w0  x2        ;*
     al  w1  x2+22     ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;*****test63*****

     jl. w3  u7.       ;  prepare answer
     jl. w3  u5.       ;  get and deliver result
     jl.     (j0.)     ;  goto return

j0:  0                 ;  saved link

e.                     ; end of test answer output header
; fpa-subproc          common procedures
; eli, 15.1.1976

; procedure answer message data received
;
; the datablock holding the answer of a message has been received.
; 
; the message is returned as an answer, with result and status as
; defined in the preceding header. the other fields in the answer
; are taken from the datablock (if any).
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2     message       unchanged
; w3     link          undefined

b. i10, j10
w.

u63: am      (x1+a50)  ; answer message data received: status(mess):=
     rl  w0  +p83      ;
     ls  w0  4         ;  status(mon):= status(mes):=
     sz. w0  (j0.)     ;  status(main)<12+
     ba. w0  1         ;  if stopped bit then 1<8
     ls  w0  8         ;
     rs  w0  g20       ;
     rs  w0  x2+8      ;
     al  w0  0         ;
     rs  w0  g21       ;  bytes:= chars:= 0
     rs  w0  g22       ;
     hs  w0  x2+9      ;

; note: link unchanged

     jl.     u5.       ;  goto get and deliver result

j0:  (:1<12:)<4        ;  stopped bit in main status<4

e.                     ; end of answer message data received
; fpa-subproc          common procedures
; eli, 15.1.1976

; procedure attention received
;
; a header with function equal to a message type (i.e. attention) has
; been received.
; the answer attention-flag is set and the bufferno saved in the
; state field of the subproc.
;
; return will be made to <link+2>.
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   undefined
; w3     link          undefined

b. i10, j10
w.

u64:                   ; attention received:
     al  w3  x3+2      ;  save link+2
     rs. w3  j0.       ;
     jl. w3  u23.      ;  testlink
     jl.     u24.      ; error: goto reject
     al  w0  v71       ;  w0:= answer attention flag+bufferno(main)
     bz  w2  x2+p88    ;
     la  w2  g53       ;  keep only last 8 bits of bufno
     lo  w0  4         ;
     lo  w0  x1+p12    ;  save in state(subproc)
     rs  w0  x1+p12    ;
     jl.     (j0.)     ;  goto link+2

j0:  0                 ; saved link+2

e.                     ; end of attention received

; stepping stones

jl.     u22.,u22=k-2


; fpa-subproc          standard types
; eli, 16.12.1975

b. q20, s10
w.

; this code handles standard sequential devices with no special
; actions, such as:
;
;     paper tape reader
;     paper tape punch
;     line printer
;     card reader
; etc.

m.               standard types

; entry point table:
h100:                  ; general sequential device
h110:                  ; paper tape reader
h112:                  ; paper tape punch
h114:                  ; line printer
h116:                  ; card reader
h120:                  ; plotter:

             q0        ;  after send message
             q1        ;  before header transmit
             q2        ;  after header transmit
             q3        ;  after header received
             q4        ;  after data received
             q5        ;  after creation

; no structure of private part of process description required
; fpa-subproc          standard types
; eli, 4.11.1975

; after send message 
;
; a new message has been received. check that user- or reservation
; status is ok and link message to queue of subproc.
; if the subproc is not busy, then link it to mainproc.
; 
; upon entry:
; w0
; w1     subproc
; w2  
; w3     

b. i10, j10
w.
q0:                    ; after send message:
     jl. w3  u4.       ;  check and link operation
     jl.     u2.       ;  goto testmore

e.                     ; end of after send message
; fpa-subproc          standard types
; eli, 21.8.1975

; before header
;
; a header (and maybe a corresponding datablock) is to be transmitted.
; find first non-processed message in queue of subproc and initialize
; transmit-parameters in mainproc.
;
; upon entry:
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.
q1:                    ; before header:
     jl. w3  u20.      ;  test answer attention
     jl. w3  u12.      ;  w2:=mes:= first pending message
     sn  w2  0         ;  if mes=0 then
     jl.     u3.       ;   goto no block.

; message found. initiate transfer

     jl. w3  u30.      ;  prepare transfer
     jl      (b101)    ;  goto mainproc return

e.                     ; end of before header
; fpa-subproc          standard types
; eli, 21.8.1975

; after header and data transmitted
;
; entered by mainproc, when a header and a corresponding datablock
; (if any) has been transmitted.
; the result of the transmission is checked and if an error has
; occured, the message is returned with result=4 (receiver
; malfunction).
;
; finally the state of the subproc is checked for transmission of a
; new block.

b. i10, j10
w.

q2:  jl. w3  u40.      ; after header: test header transmitted
     jl.     u2.       ; error: goto testmore
     jl.     u2.       ;  goto testmore

e.                     ; end of header and data transmitted
; fpa-subproc          standard types
; eli, 15.1.1976

; after header received
;
; a header has been received.
; for this kind of subprocs (with no special actions) it can
; only specify the functions <answer input with data> or
; <answer message with data>.
;
; upon entry:
; w0
; w1     subproc
; w2
; w3 

b. i10, j10
w.

q3:  jl. w3  u50.      ; after header received: test answer header
     jl.     u2.       ;  goto testmore

e.                     ; end of after header received
; fpa-subproc          standard types
; eli, 15.1.1976

; after data received
;
; check transmission.
;
; upon entry:
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q4:  jl. w3  u60.      ; after data received: test data received
     jl.     u2.       ;  goto testmore

; attention. no special action

     jl.     u2.       ;  goto testmore

e.                     ; end of data received
; fpa-subproc          standard types
; eli, 16.12.1975

; after create
;
; the subproc has just been created.
; no special action
;
; upon entry:
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q5:                    ; after create:
     jl      (b101)    ;  goto return

e.                     ; end of after create

e.                     ; end of standard types
; fpa-subproc          terminals
; eli, 20.1.1976

c.(:a80>12a.1:)-1      ; if terminal bit then include:

b. q20, s20
w.

; this code takes care of special actions (such as <to>, <from>,
; <attention> etc.) needed for terminals connected as subprocesses.

m.               terminal type

; entry point table:

h108:      q0        ; after send message
           q1        ; before header transmit
           q2        ; after header transmit
           q3        ; before data receive
           q4        ; after data receive
           q5        ; after create

; definition of local part of subproc

b. j0
w.

s0=p0                ; start of local area
j0=s0                ; save start

s5= s0               ; <special actions mask> (1 byte)
s6= s0+1, s0=s0+2    ; <special action selected> (1 byte)
s7= s0+1, s0=s0+2    ; <bufclaim>  note: position fixed. required
                     ;                   by regretted message.

s1= s0               ; <1st word of user name>
s2= s0+2             ; <2nd   -   -   -    -<
s3= s0+4             ; <3rd   -   -   -    - >
s4= s0+6, s0=s0+8    ; <4th   -   -   -    - >

; test for size of private part not exceeded

c. (:s0-j0-v1-1:)    ; v1= max size allowed for private part
     m.  fpa terminal: private part too long
z.
e.                   ; end of definition of private part

; maskbits in <special actions mask>

s10= 2.0001          ; output <:att:>
s11= 2.0010          ; input name
s12= 2.0100          ; output <:unknown:>
s13= 2.1000          ; output name
; fpa-subproc          terminals
; eli, 15.1.1976

; after send message
;
; a new message has been received.
; check accessrights and (if ok) link the message into the queue
; of pending messages. if subproc is not busy, then link subproc
; in queue of mainproc for later activation.
;
; upon entry:
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q0:                    ; after send message:
     jl. w3  u4.       ;  check and link operation
     jl.     u2.       ;  goto testmore

e.                     ; end of after send message
; fpa-subproc          terminals
; eli, 15.1.1976

; before header
;
; the subproc has been activated by mainproc for transmission
; of a header and maybe an associated datablock
;
; first pending special actions such as <answer attention>,
; output of user name etc. will be processed.
;
; then the messagequeue of the subproc is examined for a pending
; message and if none is found return is made to mainproc with a
; <no block>-status
;
; if an input- or output message is found the name of the sending
; process is output first, if it is different from <user name>,
; i.e. the name of the last sending process.
;
; otherwise standard transmission of the message is initiated.
;
; upon entry:
; w0
; w1     subproc
; w2
; w3

b. i30, j20
w.

q1:                    ; before header:
     jl. w3  u20.      ;  test answer attention

; no answer attention pending.
; test for pending special actions

     bz  w0  x1+s5     ;  if special actions mask(subproc)<>0 then
     sz  w0  s10+s11+s12+s13;
     jl.     q10.      ;  goto find special action

     jl. w3  u12.      ;  mes:= find first message
     sn  w2  0         ;  if mes=0 then
     jl.     u3.       ;   goto no block

; message found. test for input or output

     bz  w0  x2+8      ;  oper:= operation(mes)
     se  w0  3         ;  if oper=input or output then
     sn  w0  5         ;
     jl.     i1.       ;
     jl.     i4.       ;  begin

; test username

i1:  rs. w0  j0.       ;   save operation
     rl  w2  x2+6      ;   if name(sender(mes))<>user name(subproc) then
     dl  w0  x2+a11+2  ;
     sn  w3  (x1+s1)   ;
     se  w0  (x1+s2)   ;
     jl.     i2.       ;
     dl  w0  x2+a11+6  ;
     sn  w3  (x1+s3)   ;
     se  w0  (x1+s4)   ;
     jl.     i3.       ;
     jl.     i4.       ;   begin
i2:  ds  w0  x1+s2     ;    user name(subproc):= name(sender(mes))
     dl  w0  x2+a11+6  ;
i3:  ds  w0  x1+s4     ;

; the text <:to:> or <:from:> followed by the name of the
; sender should be output before the message itself

     al  w0  s13       ;    special action(subproc):= output name
     hs  w0  x1+s5     ;
     al  w0  v72       ;    special messages(state(subproc)):= true
     lo  w0  x1+p12    ;
     rs  w0  x1+p12    ;
     rl. w0  j0.       ;    goto if saved operation=output then
     se  w0  3         ;         output(FROM) else
     am      i17       ;         output(to)
     jl.     i14.      ;   end name<>user
                       ;  end input or output

; prepare normal message and (maybe) datablock

i4:  rl  w2  b18       ;  mes:= current message(monitor)
     jl. w3  u30.      ;  prepare transfer
     jl      (b101)    ;  goto mainproc return

j0:  0                 ;  saved operation

; the following table is used to select special actions
;
;  - the first byte holds a bit to be tested against the <special
;    actions mask>
;  - the second byte holds the relative address of the action (relative to i10)
;     of the action to be performed if the bit is set
;
; note, that the ordering of the entries is important. it describes
;       (as an example) that the text <:att:> should be otuput
;       before the name is read in

i10: h.
             s12, i16. ; unknown
             s10, i13. ; attention
             s11, i19. ; input name
             s13, i18. ; output name
     w.

q10:                   ; find special action:
     al. w3  i10.      ;  w0 holds special actions mask
     jl.     i12.      ;
i11: al  w3  x3+2      ;  find entry with bit set in special actions mask
i12: bz  w2  x3        ;
     so  w0  x2        ;
     jl.     i11.      ;

; w3 points to entry

     hs  w2  x1+s6     ;  save action selected
     ba  w3  x3+1      ;
     jl      x3+1      ;  goto action

; table of special texts
; first word holds length of following text in 8-bit characters

j16: i20, <:<10>att<32>:>,     i20=(:k-j16-2:)/2*3
j17: i21, <:<10>to<32>:>,      i21=(:k-j17-2:)/2*3
j18: i22, <:<10>from<32>:>,    i22=(:k-j18-2:)/2*3
j19: i23, <:unknown<10>:>,     i23=(:k-j19-2:)/2*3

i13: am      j16-j17   ; text:= att     or
i14: am      j17-j18   ;        to      or
i15: am      j18-j19   ;        from    or
i16: al. w2  j19.      ;        unknown
i17=i15-i14

; w2 points in table above

     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     al  w0  x2+2      ;  first(main):= first(text)
     rs  w0  x3+p65    ;
c.-p103
     rl  w0  x2+0      ;
     jl. w3  u15.      ;   size:= convert to 12-bit(size(text));
     wa  w0  4         ;   last:= (entry+2) + length - 2;
     rl  w3  x1+a50    ;
     rs  w0  x3+p66    ;
     rl  w0  x2        ;   size(main):= convert to 8-bit(size(text))
z.
c.p103-1
     rl  w0  x2        ;  data size(main):= header size(main):=
     rs  w0  x3+p66    ;  size(text)
z.
     rs  w0  x3+p64    ;
     al  w0  v52+(:1<0:); function(main):= output+databit
     hs  w0  x3+p61    ;
     la  w0  g50       ;  store even function in messagetable

; set rest
; 
; initiate standard parameters in mainproc
;
; upon entry:
; w0     value to store in message table(subproc, bufno)
; w1     subproc
; w2
; w3

q11: jl. w3  u9.       ; set rest: message table(subproc,bufno):= w0
     rs  w0  x2        ;
     al  w0  -1        ;  decrease(free buffers(subproc))
     ba  w0  x1+p16    ;
     hs  w0  x1+p16    ;
     jl. w3  u25.      ;  set linkparams

     jl      (b101)    ;  goto mainproc return

; initiate output of user name
;
; note: during transmission a newline character (value=10) is
;       inserted as the 12th character in the user name.
;       it is removed again after transmission.

i18: al  w0  10        ;  last character(user name(subproc)):= 10
     lo  w0  x1+s4     ;
     rs  w0  x1+s4     ;
     al  w0  v52+(:1<0:); function:= output+databit
     jl.     i5.       ;

; initiate input of user name

i19: al  w0  v70       ;  blocked(subproc):= true
     lo  w0  x1+p12    ;
     rs  w0  x1+p12    ;
     al  w0  v50       ;  function:= input
i5:                    ;
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     hs  w0  x3+p61    ;  function(main):= function selected
     al  w2  8/2*3     ;  size:= size of user name
     rs  w2  x3+p64    ;  header size(main):= size
c.-p103
     al  w0  x1+s4     ;
     rs  w0  x3+p66    ;
z.
c.p103-1
     so  w0  2.1       ;  if even(function) then size:= 0
     al  w2  0         ;
     rs  w2  x3+p66    ;  data size(main):= size
z.
     al  w0  x1+s1     ;  first(main):= first of user name(subproc)
     rs  w0  x3+p65    ;

; store function selected in message table as special flag

     bz  w0  x3+p61    ;  w0:= even function(main)
     la  w0  g50       ;
     jl.     q11.      ;  goto set rest

e.                     ; end of before header
; fpa-subproc          terminals
; eli, 16.1.1976

; after header and data transmitted
;
; a header and maybe a datablock has been transmitted
;
; if the <special action selected>-flag is nonzero it is used
; to clear a bit in the <special actions mask>. if this thereby
; becomes zero the <special messages> flag in the state-field of
; the subproc is cleared
;
; upon entry:
; w0  
; w1     subproc
; w2
; w3

b. i10, j10
w.

q2:                    ; after header:
     jl. w3  u40.      ;  test header and data transmitted
     jl.     u2.       ; error: goto testmore
     al  w3  -1        ;
     bs  w3  x1+s6     ;  if special action selected(subproc)=0 or
     am      (x1+a50)  ;    transmission state(mainproc)<>0 then
     bz  w0  +p60      ;
     se  w3  -1        ;
     se  w0  0         ;
     jl.     u2.       ;  goto testmore
     bz  w0  x1+s5     ;  remove bit in special actions mask(subproc)
     la  w0  6         ;
     hs  w0  x1+s5     ;
     al  w3  0         ;  special action selected(subproc):= 0
     hs  w3  x1+s6     ;
     al  w2  (:-1:)<8  ;  last char(username(subproc)):= 0
     la  w2  x1+s4     ;
     rs  w2  x1+s4     ;
     se  w0  0         ;  if special actions mask(subproc)<>0 then
     jl.     u2.       ;  goto testmore
     al  w0  -1-v72    ;  remove special message flag
     la  w0  x1+p12    ;
     rs  w0  x1+p12    ;
     jl.     u2.       ;  goto testmore

e.                     ; end of after header
; fpa-subproc          terminals
; eli, 15.1.1976

; before data receive
;
; activated, when a header which will be followed by a datablock has been
; received
;
; upon entry:
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q3:                    ; before data receive:
     jl. w3  u50.      ;  test answer header

; return to <link>: normal function
;  return will only be made if the datablock could not be 
;  received (sender stopped etc.)

     jl.     u2.       ;  goto testmore

; return to <link+2>: special function
;  can only be input of attention name
; note: if only a single character has been received and result and
;       status is ok (=0) then a newline character must have been
;       typed alone. in that case the datablock is skipped
;       and the current name used.

     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     al  w0  x1+s1     ;  first(main):= first of user name(subproc)
     rs  w0  x3+p85    ;
     rl  w0  x3+p84    ;  size8:=
c.p103-1
     rs  w0  x3+p86    ;  data size(main):= header size(main)
     al  w2  8         ;
     hs  w2  x3+p92    ;
z.
     bl  w2  x3+p82    ;  if size8<>1 or
     ba  w2  x3+p83+1  ;
     sn  w0  1         ;     result(main)<>0 or status(main,0:11)<>0 then
     se  w2  0         ;  
     jl.     i0.       ;  goto mainproc return
     al  w0  p162      ;  skip(main):= true
     hs  w0  x3+p80    ; 
     jl. w3  u11.      ;  clear message entry
     al  w0  -1-v70    ; 
     la  w0  x1+p12    ;  blocked(subproc):= false
     rs  w0  x1+p12    ;
     jl.     q15.      ;  goto attention name ready
i0:
c.-p103
     jl. w3  u15.      ;   size12:= convert to 12-bit(size8)
     am      (0)       ;   last(main):= first of user name(subproc)
     al  w0  x1+s1-2   ;     + size12 - 2
     rl  w2  x1+a50    ;
     rs  w0  x2+p86    ;
     hs  w3  x2+p87    ;   save chars in last word
z.
     jl      (b101)    ;   goto mainproc return


e.                     ; end of before data
; fpa-subproc          terminals
; eli, 15.1.1976

; after data received
;
; activated, when a header without data or a datablock following a
; header has been received
;
; upon entry:
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q4:                    ; after data received:
     jl. w3  u60.      ;  test data received

; return to <link>: normal function

     jl.     u2.       ;  goto testmore

; return to <link+2>: attention

     jl.     q12.      ;  goto attention received

; return to <link+4>: special function received
; a special text (unknown, to, from, att) has been output or
; an attention name has been read in.

     sn  w2  v50       ;  goto if message entry(bufno)=input then
     jl.     q13.      ;    attention name received else
     jl.     u2.       ;    testmore

e.                     ; end of after data received
; fpa-subproc          terminals
; eli, 15.1.1976

; attention received
;
; an attention message has been received.
; check reserverstatus of subproc and, if not reserved initiate
; input of name.
;

b. i10, j10
w.

q12:                   ; attention:
     rl  w0  x1+a52    ;  if reserved(subproc)<>0 then
     sn  w0  0         ;  begin comment: find reserver
     jl.     i2.       ;
     rl  w3  b6        ;   entry:= first internal in name table
     jl.     i1.       ;
i0:  al  w3  x3+2      ;   while idbit(proc(entry))<>reserver(subproc) do
i1:  rl  w2  x3        ;   entry:= entry+2
     se  w0  (x2+a14)  ;
     jl.     i0.       ;
     jl.     q14.      ;   goto process found
                       ;  end reserved<>0

; prepare subproc to print text <:att:> and read in name

i2:  al  w0  s10+s11   ;  special actions mask(subproc):= output(att),
     hs  w0  x1+s5     ;    input(name)
     al  w0  v72       ;  special messages(subproc):= true
     lo  w0  x1+p12    ;
     rs  w0  x1+p12    ;
     jl.     u2.       ;  goto testmore

e.                     ; end of attention received
; fpa-subproc          terminals
; eli, 22.1.1976

; attention name received
;
; any error status cause the text <:unknown:> to be output
;
; otherwise the terminating newline is removed and the
; name searched for

b. i10, j10
w.

q13:                   ; attention name:
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     bl  w2  x3+p82    ;
     ba  w2  x3+p83+1  ;
     se  w2  0         ;  if status(main, 0:11)=result(main)=0 then
     jl.     i0.       ;  begin
     rl  w3  x3+p84    ;   if size(main)=0 then
     sn  w3  0         ;   goto testmore
     jl.     u2.       ;   mask of last received character with value=10
     al  w3  x3-1      ;
     wd. w3  j1.       ;   note: w2 already zero
     ls  w3  1         ;   index:= (size-1)//3*2
     ls  w2  3         ;   position:= -((size-1) mod 3*8)
     ac  w2  x2        ;
     rl. w0  j0.       ;   mask:= newline shift position
     as  w0  x2        ;
     am      x3        ;   address:= first of user name(subproc)+index
     al  w3  x1+s1     ;
     la  w0  x3        ;
i1:  rs  w0  x3        ;
     al  w0  0         ;   rest of user name(subproc):= 0
     al  w3  x3+2      ;
     sh  w3  x1+s4     ;
     jl.     i1.       ;

; now a terminating newline has been replaced by a zero
;  search for process

q15:                   ; attention name ready:
     al  w2  x1+s1     ;   search name(user,entry,interval(subproc))
     dl  w1  x1+a49    ;
     jl  w3  d71       ;
     rl  w1  b19       ;
     sn  w3  (b7)      ;   if entry= name table end then goto unknown
     jl.     i0.       ;
     rl  w2  x3        ;   if kind(entry)<>internal or pseudoproc then
     rl  w0  x2+a10    ;   goto unknown
     se  w0  64        ;   goto process found
     sn  w0  0         ;
     jl.     q14.      ;  end

; prepare subproc to output the text <:unknown:>

i0:  al  w0  s12       ;  special actions mask(subproc):= output(unknown)
     hs  w0  x1+s5     ;
     al  w0  v72       ;  special messages(subprocstate):= true
     lo  w0  x1+p12    ;
     rs  w0  x1+p12    ;
     jl.     u2.       ;  goto testmore

j0:  (:-1-10:)<16      ;  mask to remove newline
j1:  3                 ;  division constant

e.                     ; end of attention name
; fpa-subproc          terminals
; eli, 15.1.1976

; process found
;
; clear message queue and deliver attention message
;
; upon entry:
; w0
; w1     subproc
; w2
; w3     name table addr. of receiver of attention buffer

b. i10, j10
w.

q14:                   ; process found:
     rs. w3  j1.       ;  save name table address
     rl  w2  b8+4      ;  mes:= first message
     jl.     i1.       ;
i0:  wa  w2  b8+8      ;  while sender(mes)<>subproc do
     sl  w2  (b8+6)    ;
     jl.     i2.       ;
i1:  se  w1  (x2+6)    ;  mes:= next(mes)
     jl.     i0.       ;

; regret message found.
; note: will increase buffer claim by one

     jl  w3  d75       ;   regretted message(mes)
i2:  rl. w3  (j1.)     ;
     rl  w0  x3+a14    ;  if receiver is user of mainproc(subproc)
     am      (x1+a50)  ;  then receiver is made user of subproc
     la  w0  +a53      ;
     lo  w0  x1+a53    ;
     rs  w0  x1+a53    ;
c.-p103
     rl  w2  b8        ;   buf:= next(message queue)
     rs. w2  j1.       ;   save buf
     rs  w3  x2+4      ;   receiver(buf):= process found
     rs  w1  x2+6      ;   sender(mes):= subproc
     jl  w3  d5        ;   remove(mes)
z.
     ld  w0  -65       ;  bytes:= chars:=0
     ds  w0  g22       ;
     rl. w0  j0.       ;  status:= attention
     rs  w0  g20       ;
     jl.     i4.       ;  for mes:= first pending(subproc) while mes<>0 do
i3:  jl  w3  g18       ;  deliver result(1,mes,intervention)
i4:  jl. w3  u22.      ;
     se  w2  0         ;
     jl.     i3.       ;

; get message and deliver it
c.-p103
     rl. w2  j1.       ;
     jl  w3  d16       ;   deliver message(mes)
z.
c.p103-1

     rl. w3  j1.       ;  w3:= name table addr. of receiver
     jd      1<11+16   ;  send message(w1=sender, w3=name table of rec.)
z.


; end of attention

     jl.     u2.       ;  goto testmore

j0:  1<16              ;  attention status
j1:  0                 ;  saved message or process

e.                     ; end of process found
; fpa-subproc          terminals
; eli, 16.12.1975

; after create
;
; the subproc has just been created.
;
; upon entry:
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q5:                    ; after create:
     al  w0  0         ;  user name(subproc,0):= 0
     rs  w0  x1+s1     ;  action selected(subproc):=
     rs  w0  x1+s6     ;  action mask(subproc):= 0
     jl      (b101)    ;  goto return

e.                     ; end of after create

e.                     ; end of terminals

z.                     ;

h108=h100

; fpa-subproc          magnetic tape
; eli, 4.11.1975

c.(:a80>13a.1:)-1      ; if magtape bit then include:

b. q20, s10
w.

; this code takes care of special actions for magnetic tapes,
; connected to rc4000 through a devicecontroler

m.               magnetic tape type

; entry point table:

h118:      q0        ; after send message
           q1        ; before header transmit
           q2        ; after header  transmit
           q3        ; after header received
           q4        ; after data received
           q5        ; after create

; definition of local part of subproc

b. j0
w.

s0=p0                ;  start of local area
j0=s0                ;  save start

s1= s0,   s0=s0+2    ;  <state>
s2= s0,   s0=s0+2    ;  <file count>
s3= s0,   s0=s0+2    ;  <block count>
s5= s0,   s0=s0+2    ;   <last status>
          s0=s0+2    ;  one unused word
s4= s0,   s0=s0+2    ;  <remoter proc>

; test for size of private part not exceeded

c.(:s0-j0-v1-1:)     ;  v1= max. size of private part
     m. fpa magnetic tape: private part too long
z.
e.                   ; end of definition of local part
; fpa-subproc          magnetic tape
; eli, 12.9.1975

; after send message
;
; a new message has been received.
; check message and link it to queue of subproc.
; if subproc is free, then link it to mainproc.
;
; upon entry:
; w0     
; w1     subproc
; w2     
; w3

b. i10, j10
w.

q0:  jl. w3  u4.       ; after send message: check and link operation
     al  w0  0         ;  state(magnetic tape):= 0
     rs  w0  x1+s1     ;
     rl  w2  b18       ; 
     bz  w0  x2+8      ;  oper:= operation(mes)
     se  w0  5         ;  if oper<>output then
     jl.     u2.       ;  goto testmore
     al  w3  1         ;  sizeminus1:=
     wa  w3  x2+12     ;   last(mes)-first(mes)+1
     ws  w3  x2+10     ;  if sizeminus1>=maxsize(subproc) then
     sl  w3  (x1+p18)  ;
     jl      g5        ;  goto result 3
     jl.     u2.       ;  goto testmore

e.                     ; end of after send message
; fpa-subproc          magnetic tape
; eli, 15.1.1976

; before header
;
; examine the message-queue of the subproc for a pending message.
; if none is found return to mainproc with <no block>-status.
;
; otherwise initialize the mainproc sender table for transmission
; of a header and maybe a datablock.
;
; upon entry:
; w0     
; w1     subproc
; w2
; w3

b. i10, j10
w.

q1:                    ; before header:
     jl. w3  u20.      ;  test answer attention
     jl. w3  u12.      ;  mes:= find first message(subproc)
     sn  w2  0         ;  if mes=0 then
     jl.     u3.       ;   goto no block
     bz  w0  x2+8      ;
     so  w0  2.1       ;   if odd operation then
     jl.     j0.       ;     examine sender(mess);
     jl  w3  g34       ;      stopped: goto stopped;
     jl.     j1.       ;      ok:

j0:  jl. w3  u30.      ;  prepare transfer

     al  w0  0         ;  current message(subproc):= 0
     rs  w0  x1+p13    ;

; the stop count of the sender will be increased at
; this point for input messages, thus assuring that the sender has not been
; stopped when the datablock arrives.

     bz  w0  x2+8      ;  if oper(mes)<>input then
     se  w0  3         ;
     jl      (b101)    ;  goto mainproc return
     jl. w3  u21.      ;  test and increase stop count
     jl.     u3.       ; stopped: goto no block
     jl      (b101)    ; ok: goto mainproc return

j1:  sn  w2 (x1+a54)   ; stopped:
     jl.     j2.       ;   if not first in mess queue then
     rl  w0  x1+s5     ;    (no operations under execution)
     rs  w0  g20       ;     status(mess):=saved status(sub);
     ld  w0  -100      ;
     ds  w0  g22       ;      bytes, chars trf(mess):=0,0;
     dl  w0  x1+s3     ;   file,block count(mess):=saved file, block count(sub);
     ds  w0  g24       ;
     jl  w3  g18       ;     deliver result1;
     jl.     u2.       ;     goto testmore;
j2:  al  w0  p164      ;   else
     am     (x1+a50)   ;     internal state(main):=regretted;
     hs  w0  +p60      ;
     jl     (b101)     ;     return to main;

e.                     ; end of before header
; fpa-subproc          magnetic tape
; eli, 15.1.1976

; after header transmitted
;
; a header and maybe a datablock has been transmitted.
;
; transmission is checked
;
; upon entry
; w0    
; w1     subproc
; w2
; w3

b. i10, j10
w.

q2:                    ; after header transmit:
     jl. w3  u40.      ;  test header and data transmitted
     jl.     u2.       ; error: goto testmore
     jl.     u2.       ;  goto testmore

e.                     ; end of header transmitted
; fpa-subproc          magnetic tape
; eli, 15.1.1976

; after header received
;
; a header has been received.
; the function of the header may be
;
;     <answer input with data> or <answer message with data>
;
; upon entry:
; w0
; w1     subproc
; w2    
; w3

b. i10, j10
w.
q3:                    ; before data receive:
     jl. w3  u50.      ;  test answer header
     jl.     u2.       ;  goto testmore

e.                     ; end of after header received
; fpa-subproc          magnetic tape
; eli, 5.11.1975

; after data received
;
; a datablock following a header has been received.
;
; first adjust the position of the tape described in <file count>
; and <block count>.
;
; then check transmission in standard way
;
; upon entry
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q4:  jl. w3  q10.      ; after data received: adjust position
     jl. w3  u60.      ;  test data received
     jl.     u2.       ;  goto testmore

; <link+2>: attention received
; find remoterprocess, if any

     rl  w0  (b3)      ;  remoter:= first in name table
     rs  w0  x1+s4     ;
     jl. w3  q11.      ;  clear queue(state:= 2)
i0:  rl  w3  x1+s4     ; next:
     rl  w2  x3+a54    ;  rem:= remoter(subproc); mes:= first mes(rem)
     se  w3  0         ;  if rem=0 or empty(mes) then
     sn  w2  x3+a54    ;
     jl.     u2.       ;  goto testmore
     rs  w2  b18       ;  current buf:= mes
     al  w0  0         ;
     ds  w1  g21       ;  answer(0):= 0; answer(2):= proc
     jl  w3  g18       ;  deliver result(1)
     jl.     i0.       ;  goto next

e.
; fpa-subproc          magnetic tape
; eli, 5.11.1975

; after create
;
; the subproc has just been created.
; no special actions needed
;
; upon entry
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.
q5:                    ; after create:
     rl  w0  (b3)      ;  remoter(subproc):= first in name table
     rs  w0  x1+s4     ;
     jl      (b101)    ;  goto return

e.                     ; end of after create

; fpa-subproc          magnetic tape
; eli, 14.9.1975

; procedure adjust position
;
; the position of the tape as described in <file count> and <block count>
; is adjusted in the following way:
;
; after an input- or output operation <block count> is increased by
; one, unless
;     status bit2 (timer) is set or
;     the size-field of mainproc is zero.
;
; if status bit7 is set (tape mark), <file count> is increased by
; one and <block count> is cleared.
;
; in case of answer message with data, the <file count> and
; <block count> is given in the datablock following.
;
; the new values of <block count> and <file count> are stored
; in the answer-variables g23 and g24, ready for sending of an
; answer
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   unchanged
; w3     link          unchanged

b. i10, j10
w.

q10: ds. w3  j0.       ; adjust position: save link and w2
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     bl  w0  x3+p83+1  ;  if status(main)=intervention then
     sh  w0  -1        ;
     jl.     i4.       ;  goto intervention
     rs  w0  x1+s5     ;  last status(proc):=status(main);
     bz  w0  x3+p81    ;  func:= function(main)
     rl  w2  0         ;  save function in w2
     la  w0  g50       ;  remove databit
     se  w0  v51       ;  if func=answer input or
     sn  w0  v53       ;     func=answer output then
     jl.     i0.       ;  goto increase
     se  w2  v55+(:1<0:); if func<>answer message with data then
     jl.     i2.       ;  goto set g23 and g24

; get values from datablock of answer

     am      (x1+a50)  ;  w2:= first received address(mainproc(subproc))
     rl  w2  +p85      ;
     dl  w0  x2+8      ;  get file- and blockcount from datablock
     ds  w0  x1+s3     ;  goto set g23 and g24
     jl.     i2.       ;

; after input- or output
; adjust file- and blockcount as described above

i0:  bz  w2  x3+p83+1  ; increase:
     rl  w3  x3+p84    ;  if timer(status(main))=0 and
     so  w2  1<9       ;     size(main)<>0 then
     sn  w3  0         ;
     jl.     i1.       ;  
     dl  w0  x1+s3     ;   block count(subproc):= 
     ba. w0  1         ;      blockcount(subproc)+1
     rs  w0  x1+s3     ;

i1:  so  w2  1<4       ;  if tape mark(status(main))=1 then
     jl.     i2.       ;  begin
     al  w3  1         ;   file count(subproc):= file count(subproc)+1
     wa  w3  x1+s2     ;
     al  w0  0         ;   block count(subproc):= 0
     ds  w0  x1+s3     ;  end

; set new (or saved) content in g23 and g24.
; w3w0 holds value

i2:  dl  w0  x1+s3     ; set g23 and g24:
     ds  w0  g24       ;
     jl.     i3.       ;

; intervention status (tape has been set local)

i4:  jl. w3  q12.      ;  clear queue(state:= 1)

; restore w2 and w3 and return

i3:  dl. w3  j0.       ;
     jl      x3        ;

     0                 ; saved w2
j0:  0                 ; saved link

e.                     ; end of procedure adjust position
; fpa-subproc          magnetic tape
; eli, 25.3.1976

; procedure clear queue
;
; called when the tape has been set offline or online.
; the name of the process is removed. an eventual reserver
; is removed. filecount, blockcount are set to -1.
; state is set depending on entrypoint selected.
; an answer with result 4 from the device is simulated.
; all pending messages are returned with result 5 (unknown).
;
;        call          return
; w0                   undefined
; w1     subproc       unchanged
; w2                   undefined
; w3     link          undefined

b. i10, j10
w.

                       ; clear queue:
q11: am      1         ;     state:= 2 (i.e. unknown mounted)
q12: al  w0  1         ;  or state:= 1 (i.e. local)
     rs  w0  x1+s1     ;
     rs. w3  j0.       ;  save link
     al  w0  0         ;  reserver(subproc):=
     rs  w0  x1+a11    ;  name(0):=  0
     rs  w0  x1+a52    ;
     rs  w0  x1+s5     ;  last status(proc):=status(main);
     al  w0  4         ;  simulated result(mainproc(subproc)):= 4
     am      (x1+a50)  ;
     hs  w0  +p82      ;
     al  w0  -1        ;  filecount(subproc):=
     al  w3  -1        ;  blockcount(subproc):= -1
     ds  w0  x1+s3     ;
     jl.     i1.       ;
i0:  al  w0  5         ;  for mes:= all unprocessed messages(subproc) do
     jl  w3  g19       ;  deliver result(mes, 5)
i1:  jl. w3  u22.      ;
     se  w2  0         ;
     jl.     i0.       ;

; return

     jl.     (j0.)     ;

j0:  0                 ;  saved link

e.                     ; end of clear queue

e.                     ; end of magnetic tape

z.                     ;

h118=h100



; stepping stones.

     jl.   u2.   , u2 =k-2
     jl.   u20.  , u20=k-2
     jl.   u21.  , u21=k-2


; fpa-subproc          disc- and areatypes
; eli, 14.10.1975

c.(:a80>14a.1:)-1     ; if disc bit then include:

b. q20, s10
w.
;
; a disc connected to an rc3600 is in rc4000 represented by a subproc.
;
; an area on the disc is represented by a normal area process having
; 'document name' equal to the name of the disc-subproc (as defined
; by 'create peripheral process').
;
; the filestructure of the disc is defined in the normal way by a 
; slicetable in the monitor, provided the disc has been included in
; the bs-system by a call of 'include bs'.
;
; messages may be sent either directly to the disc, in which case
; absolute segment addressing is used, or to an areaprocess in which
; case adressing relative to the start of the area is used.
;
; the following subproc handles both messages to discs and areas.
; the only difference is the initial handling of the message just
; after 'send message'. here the segment number in a message to an
; areaprocess is converted to a physical (absolute) segment number.
;
; like other subprocesses a message may be split into a number of
; messages to the device, each (exept the last) corresponding to
; the maximum buffer length of the device as stated in 'create'.
; but due to the file structure of a disc another level of message-
; splitting is introduced (note: this level of message-splitting
; is already known from the existing handling of a disc, connected
; directly to an rc4000).
;
;    a file need not correspond to a number of physically con-
;    secutive segments.
;
; therefore a message to an areaprocess is treated in the following
; levels:
;
;    1. message level
;       2. slice level: prepare a number of consecutive segments.
;          3. buffer level: transfer these segments in a number
;             of blocks corresponding to the maximum device buffer
;             length.
;
; stage 3 is executed 1 or more times for each instance of stage 2,
; and stage 2 is repeated for each group of consecutive segments
; until either the file in question or the message data area suppli-
; ed from the internal process is exhausted.
;
; in stage 2 and 3 there is no destinction between messages originally
; sent to an areaprocess or to a discprocess. as there is no file-
; structure for messages to the disc, stage 2 must 'automatically'
; be dummy in that case.
;
; the subproc uses the message as storage for information making this
; possible.
;
; originally a message to an area- or a discprocess holds the following
; information:
;
;    message+8:   operation<12+mode
;          +10:   first address
;          +12:   last address
;          +14:   first segment
;                 (absolute for messages to disc,
;                 relative to start of area otherwise)
;
; after 'send message' and in the following processing of the message
; it is transformed in the following way:
;
;    message+8:   unchanged from above
;          +10:   unchanged from above
;          +12:   last address corresponding to current consecutive
;                 segments (initially set equal to +10)
;          +14:   first physical segment 
;          +16:   next physical segment, i.e. start segment for the
;                 next consecutive segments
;          +18:   original value of last address (from above)
;          +20:   expected size
;          +22:   updated first address
;
; note, that +8, +10, +12, +20 and +22 corresponds to a message as it
; is normally required by the common fpa-procedures.
; these procedures may then handle the splitting of the consecutive
; segments depending on the buffersize of the device. only a little
; extra code is required here, taking care of updating of 'first phy-
; sical segment' after each transfer.
;
; when the consecutive segments are exhausted the next number of 
; consecutive segments are selected, and +12, +14 and +16 updated
; correspondingly.
;
; for a message directly to the discprocess, +12 and +18 will be
; set equal to each other, thus simulating that the last part of a
; message is processed.
;
; when a message is sent to an areaprocess the standard 'send message'
; action is entered. there the discprocess corresponding to the area
; is found and if the kind of the discprocess is a subprocess, a jump
; is performed through send message for subprocs to the
; send message action for disc-subprocs. a flag in the
; subproc description shows the area process that is the
; actual receiver of the message
;
; a message to the discprocess itself enters here at q0.
; fpa-subproc          disc- and areatypes
; eli, 15.10.1975

m.               disc type

; entry point table

h106:        q0        ; after send message (only for disc)
             q1        ; before header
             q2        ; after header transmit
             q3        ; after header receive
             q4        ; after data receive
             q5        ; after create

; definition of local part of subproc

b. j0
w.

s0= p0                 ; start of local part
j0= p0                 ; save start

        s0=s0+2        ; 1 unused word
s2=s0,  s0=s0+2        ; <chaintable>
s3=s0,  s0=s0+2        ; <slicelength>
s4=s0,  s0=s0+2        ; <state>

; test for size of private part not exceeded

c. (:s0-j0-v1-1:)
   m. fpa subproc: disctype private part too long
z.
e.                     ; 

q12:         (:-1:)<9  ; constant to mask of to integral number
                       ; of segments
; fpa-subproc          disc- and areatypes
; eli, 22.1.1976

; after send message (disc)
;
; set up the message, so that the procedure 'prepare consecutive
; area' will be dummy when applied to this message. this is done
; by setting
;
;    saved last address(message):= first addr(mes)+
;       (first addr(mes)-last addr(mes))//512*512
;
; upon entry:
; w0   
; w1     subproc
; w2     
; w3

b. i10, j10
w.

q0:                    ; after send message:
     rl  w0  x1+a56    ;  if called via areaprocess then
     sz  w0  (:-1:)<1  ;
     jl.     q11.      ;   goto after send message(area)
     jl. w3  u4.       ;  check and link operation
     rl  w2  b18       ;  w2:= current message
     bz  w0  x2+8      ;  if oper(mes)<>input and
     se  w0  3         ;     oper(mes)<>output then 
     sn  w0  5         ;
     jl.     i0.       ;  
     jl.     u2.       ;  goto testmore
i0:  al  w3  2         ;  saved last(mes):= last(mes):=
     wa  w3  x2+12     ;
     rl  w0  x2+10     ;    (last(mes)-first(mes)+2)//512*512
     ws  w3  0         ;
     la. w3  q12.      ;
     wa  w3  0         ;    + first(mes)
     al  w3  x3-2      ;    - 2
     rs  w3  x2+12     ;
     rs  w3  x2+18     ;
                       ;
     jl.     u2.       ;  goto testmore

e.
; fpa-subproc          disc- and areatypes
; eli, 22.1.1976

; after send message (area)
;
; prepare message for first call of 'prepare consecutive area'

; note, that upon entry w0 will hold the areaprocess address,
;       and b19 (monitor entry) will hold the mainproc
;       address of the areaprocess (i.e. the disc-subproc)
;
; upon entry:
; w0     area
; w1     subproc (disc)   
; w2
; w3

b. i10, j10
w.

q11:                   ; after send message:
     al  w2  0         ;  called via areaprocess:= false
     rs  w2  x1+a56    ;
     rl  w1  0         ;  proc:= area
     rl  w2  b18       ;  w2:= current message
     bz  w0  x2+8      ;  if oper(mes)<>input and
     se  w0  3         ;     oper(mes)<>output then
     sn  w0  5         ;
     jl.     i0.       ;
     jl.     i1.       ;  goto link

; input or output operation

i0:  rl  w0  x2+14     ;  if first segment(mes)<0 or
     sl  w0  0         ;     first segment(mes)>=segments(area) then
     sl  w0  (x1+a61)  ;  goto outside
     jl.     i2.       ;

; adjust addresses to correspond to an integral number of
; segments

     dl  w0  x2+12     ;  last:= last(mes)
     rs  w3  x2+22     ;  updated first(mes):= first(mes)
     al  w3  x3-2      ;
     rs  w3  x2+12     ;  last(mes):= first(mes)-2
     ws  w0  6         ;  coresize:= (last-first(mes)+2)//512*512
     la. w0  q12.      ;
     rl  w3  x1+a61    ;  areasize:= (segments(area)-first segment(mes))*512
     ws  w3  x2+14     ;
     ls  w3  9         ;
     sh  w0  (6)       ;  size:= min(coresize, areasize)
     rl  w3  0         ;
     al  w3  x3-2      ;
     wa  w3  x2+10     ;  saved last(mes):= first(mes)+ size -2
     rs  w3  x2+18     ;

; get start in chain table of segments

     rl  w0  x2+14     ;  no of slices:= first segment(mes)/
     al  w3  0         ;                 slicelength(mainproc(area))
     am      (x1+a50)  ;
     wd  w0  +s3       ;
     rs  w3  x2+16     ;  save first segment in slice

; normally last(mes) points to the last address for which data
;   has been transferred.
; segments are normally transferred from the first segment in
;   a slice an on. this does however not hold for the first
;   transfer, where it starts with segment no
;   (first segment modulo slicelength).
; this is corrected for by subtracting from last(mes)
;   the core occupied by the not transferred segments in the
;   slice.
; this makes last(mes) point to a logical address (ahead of the
;   users buffer) where the transfer of a previous slice would have 
;   terminated.

     ls  w3  9         ;  last(mes):= last(mes)-
     rx  w3  x2+12     ;
     ws  w3  x2+12     ;    first segm in slice*512
     rs  w3  x2+12     ;
     rl  w2  x1+a60    ;  w2:= first slice(area)

; now change to run in mainproc(area), i.e. in the subproc actually
; corresponding to the disc

     rl  w1  x1+a50    ;  proc:= mainproc(area)
     wa  w2  x1+s2     ;  first slice:= first slice(area)+chaintable(proc)
     jl  w3  d74       ;  follow chain(w2=first slice, w0=no of slices)
     ws  w2  x1+s2     ;  next phys segm:= slice*slicelength(proc)+
     al  w0  x2        ;
     rl  w2  b18       ;  +
     wm  w0  x1+s3     ;
     wa  w0  x2+16     ;  first segment in slice
     rs  w0  x2+16     ;
     jl. w3  q10.      ;  prepare consecutive area
i1:  am      (b19)     ; link:
     al  w1  +a54      ;  w1:= addr of message queue of subproc
     jl  w3  d6        ;  link(w1=head, w2=elem)
     rl  w1  b19       ;  restore current subproc.
     jl.     u2.       ;  goto testmore

; first segment of message is outside the area. return
; status 'end of document'.

i2:  rl  w1  g62       ; outside: status:= bit5
     rs  w1  g20       ;
     ld  w1  -65       ;  bytes:= chars:= 0
     ds  w1  g22       ;
     jl  w3  g18       ;  deliver result(1)
     jl.     u2.       ;  goto testmore

e.                     ; end of after message (area)
; fpa-subproc          disc- and areatypes
; eli, 14.10.1975

; before header (disc and area)
;
; prepare transmission of next block.
;
; note, that the fields <status> and <mode> are used to hold the
; segment number in case of an input- or output operation.
;
; upon entry
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.
q1:                    ; before header:
     jl. w3  u20.      ;  test answer attention
     jl. w3  u12.      ;  w2:= find first message
     sn  w2  0         ;  if w2=0 then
     jl.     u3.       ;   goto no block

; test for input- or output message

     jl. w3  u30.      ;  prepare transfer(message)
     bz  w0  x2+8      ;  if oper(mes)<>input and
     se  w0  3         ;     oper(mes)<>output then
     sn  w0  5         ;
     jl.     i1.       ;
     jl      (b101)    ;  goto mainproc return
i1:  rl  w0  x2+14     ;  w0:= first phys segment(mes)
     am      (x1+a50)  ;  state,mode(mainproc(subproc)):= w0
     rs  w0  +p63      ;

; increase stop count at this time also for input messages,
; thus ensuring that the process is still present when
; the answer arrives (which does not take long time for
; discs)

     jl. w3  u21.      ;  test and increase stop count
     jl.     u3.       ; stopped: goto no block
     jl      (b101)    ; running: goto mainproc return

e.                     ; end of before header

; fpa-subproc          disc- and areatypes
; eli, 3.2.1976

; after header transmit
;
; a header and maybe a corresponding datablock has been transmitted.
; for messages originally sent to an areaprocess, the field
; first physical segment is increased corresponding to the
; size of the datablock transferred.
;
; upon entry:
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q2:                    ; after header transmit:
     jl. w3  u8.       ;  mes:= message table(current bufno)
     rs. w2  j0.       ;  save mes
     jl. w3  u40.      ;  test header transmit
     jl.     u2.       ; error: goto testmore
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     bz  w0  x3+p61    ;  if function(main)<>input and
     se  w0  v50       ;     function(main)<>output then
     sn  w0  v52+(:1<0:);
     jl.     i0.       ;
     jl.     u2.       ;  goto testmore
i0:  rl  w0  x3+p64    ;  segments:= convert to 12(size(main))//512
     jl. w3  u15.      ;
     ls  w0  -9        ;
     rl. w2  j0.       ;  restore mes
     wa  w0  x2+14     ;  first phys segm(mes):= first phys segm(mes)+segments
     rs  w0  x2+14     ;

; if the last portion of the current consecutive area has been
;   initialized and more is to be transferred, then prepare
;   next consecutive segments.

     rl  w3  x1+p13    ;  if current message(subproc)=0 and
     rl  w0  x2+12     ;     last(mes)<>saved last(mes) then
     sn  w3  0         ;  begin
     sn  w0  (x2+18)   ;
     jl.     u2.       ;
     rs  w2  x1+p13    ;   current message(subproc):= mes
     jl. w3  q10.      ;   prepare consecutive area
                       ;  end
     jl.     u2.       ;  goto testmore

j0:  0                 ;  saved message address

e.                     ; end of after header transmit
; fpa-subproc          disc- and areatypes
; eli, 14.10.1975

; after header received
;
; a header has been received.
; no special actions required
;
; upon entry
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q3:  jl. w3  u50.      ; after header receive: test header received
     jl.     u2.       ;  goto testmore

e.                     ; end of after header received
; fpa-subproc          disc- and areatypes
; eli, 14.10.1975

; after data received
;
; a datablock following a header has been received
; 
; status intervention or result disconnected will cause the name of the
; subproc to be removed and the message returned with result 5
; (receiver does not exist)
;
; upon entry
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q4:                    ; after data:
     rl  w3  x1+a50    ;  main:= mainproc(subproc)
     bl  w2  x3+p82    ;  if result(main)=disconnected or
     bl  w0  x3+p81+1  ;     status(main)=intervention then
     sl  w0  0         ;  begin comment: remove name of proces;
     sn  w2  3         ;
     jl.     +4        ;
     jl.     i1.       ;
     al  w0  4         ;   simulated result(main):= 4
     hs  w0  x3+p82    ;
     al  w0  0         ;   name(subproc):=
     rs  w0  x1+a11    ;   reserver(subproc):= 0
     rs  w0  x1+a52    ;
     rl  w3  b5        ;   for area:= all area procs do
i0:  rl  w2  x3        ;
     sn  w1  (x2+a50)  ;   if main(area)=subpproc then
     rs  w0  x2+a50    ;   main(area):= 0
     al  w3  x3+2      ;
     se  w3  (b6)      ;
     jl.     i0.       ;  end
                       ;
i1:  jl. w3  u60.      ;  test data received
     jl.     u2.       ; normal:    goto testmore
     jl.     u2.       ; attention: goto testmore

e.                     ; end of data received

; fpa-subproc          disc- and areatypes
; eli, 16.12.1975

; after create
;
; a disctype subproc has been created.
;
; the fields <chaintable> and <slice length> will later be
; initialized by procfunc when an internal process executes
; 'create bs'.
;
; upon entry
; w0
; w1     subproc
; w2
; w3

b. i10, j10
w.

q5:                    ; after create:

; adjust maximum buffer size to an integral number of segments

     rl. w0  q12.      ;
     la  w0  x1+p18    ;  size(subproc):= size(subproc)//512*512
     rs  w0  x1+p18    ;

     jl      (b101)    ;  goto return

e.                     ; end of create
; fpa-subproc          disc- and areatypes
; eli, 22.1.1976

; procedure prepare consecutive area
;
; makes the pointers <updated first> and <last> in the
; messagebuffer describe a storage area corresponding to
; a number of consecutive disc segments
;
;        call          return
; w0                   undefined
; w1     subproc(disc) unchanged
; w2     message       unchanged
; w3     link          undefined

b. i10, j10
w.

q10: ds. w3  j1.       ; prepare consecutive area:
     rl  w0  x2+16     ;  save message and link
     rs  w0  x2+14     ;  first phys segm(mes):= next phys segm(mes)
     al  w3  0         ;  slice:= next phys segm(mes)/slicelength(subproc)+
     wd  w0  x1+s3     ;  
     wa  w0  x1+s2     ;  chaintable(subproc)
     rl  w3  x2+18     ;
     rl  w2  x1+s3     ;  length:= slicelength(subproc)*512
     ls  w2  9         ;
     ds. w3  j3.       ;
     am.     (j0.)     ;
     rl  w3  +12       ;
     wa. w3  j2.       ;  addr:= last addr(mes)+ length

; scan slicetable as long as a slice with content 1 is encountered

i0:  bz  w2  (0)       ;  while chaintable(slice)=1 and
     sn  w2  1         ;        addr<saved last(mes) do
     sl. w3  (j3.)     ;  begin
     jl.     i1.       ;
     ba. w0  1         ;   slice:= slice+1
     wa. w3  j2.       ;   addr:= addr+length
     jl.     i0.       ;  end

; dataarea at user exhausted or nonconsecutive segments

i1:  rl. w2  j0.       ;  restore message
     sl. w3  (j3.)     ;  if addr<saved last(mes) then
     jl.     i2.       ;  begin nonconsecutive, more to send.
     rs  w3  x2+12     ;   last(mes):= addr
     ba  w0  (0)       ;   next phys segm(mes):= (next slice(slice)-
     ws  w0  x1+s2     ;      chaintable(subproc))*slicelength(subproc)
     wm  w0  x1+s3     ;
     rs  w0  x2+16     ;  
     jl.     (j1.)     ;  end else
     
i2:  rl  w0  x2+18     ;   last addr(mes):= saved last(mes)
     rs  w0  x2+12     ;

; return

     jl.     (j1.)     ;  goto return

; working locations

j0:  0                 ;  saved message
j1:  0                 ;  saved link
j2:  0                 ;  length (i.e. slicelength*512)
j3:  0                 ;  saved last address(mes)

e.                     ; end of prepare consecutive area



e.                     ; end of disc- and areatypes

z.                    ;

h106=h100

; fpa-subproc          discette
; jr, 78.08.22

c.(:a80>15a.1:)-1     ; if flexible disc bit then include:

; stepping stone:
     jl.     u12., u12=k-2


b. q20,s10,n10 w.

; this subdriver is used for links to discettes. it differs from the
; 'standard type driver' in these ways:
;   - the stopcount of a sender that wants to input is raised
;     already in entry 1 to prevent a stopped sender when receiving in
;     entry 3.
;   - if sender is stopped (only when inputting or outputting) in entry 1,
;     the state of the process is set to 'stopped' which causes all messages
;     (except reset) to be answered immediately with status stopped.

; note: this driver cannot handle links with more than one operation.

m.               discette

; entry point table:
h122:                  ; discette:

             q0        ;  after send message
             q1        ;  before header transmit
             q2        ;  after header transmit
             q3        ;  after header received
             q4        ;  after data received
             q5        ;  after creation

; definition of privat part of process description:

   s0=p0               ; state

; state :  0   running
;          2   waiting for stop
;          4   stopped


; fpa-subproc         discette
; jr, 78.08.22

; after send message 
;
; a new message has been received. check that user- or reservation
; status is ok and link message to queue of subproc.
; if state is stopped and if operation is not reset then
; deliver answer with status stopped.
; if operation is reset then state is changed to running.
; if the subproc is not busy, then link it to mainproc.
; 
; upon entry: w1=subproc

b. i10,j10 w.

q0:                    ; after send message:
     jl. w3  u4.       ;   check and link operation;
     rl  w3  x1+s0     ;   
     jl.     x3+i0.    ;   goto case state of
i0:  jl.     u2.       ;    ( 0: testmore,
     jl.     j2.       ;      2: exit0,
                       ;      4: stopped);

j0:  am     (b18)      ; stopped:
     bz  w0  +8        ;
     se  w0  2         ;   if operation(mess)=reset then
     jl.     j1.       ;     state:=running;
     al  w0  0         ;     goto testmore;
     rs  w0  x1+s0     ;
     jl.     u2.       ;
j1:  jl. w3  n0.       ;   deliver result(stopped);
j2:  jl     (b101)     ; exit0: return;

e.                     ; end of after send message

; fpa-subproc          discette
; jr, 78.08.22

; before header
;
; a header (and maybe a corresponding datablock) is to be transmitted.
; find first non-processed message in queue of subproc and initialize
; transmit-parameters in mainproc.
;
; upon entry: w1=subproc

b. i10,j10 w.

q1:                    ; before header:
     jl. w3  u20.      ;   test answer attention;
     jl. w3  u12.      ;   mes:= first pending message;
     sn  w2  0         ;   if mes=0 then
     jl.     u3.       ;     goto no block;

; message found.

     bz  w0  x2+8      ;
     so  w0  2.1       ;   if odd operation then
     jl.     j0.       ;     examine sender(mess);
     jl  w3  g34       ;      stopped: goto stopped;
     jl.     j1.       ;      ok:

j0:  jl. w3  u30.      ;   prepare transfer;
     bz  w0  x2+8      ;
     so  w0  3         ;   if operation=input then
     jl      (b101)    ;
     jl. w3  u21.      ;   test and increase stopcount;
             -1        ;    stopped: impossible (checked above(g34));
     jl      (b101)    ;   goto mainproc return;

j1:  jl. w3  n1.       ; stopped: check queue;
     jl.     u3.       ;    queue not empty: goto no block;
     jl. w3  n2.       ;    queue empty: clean mess queue;
     jl.     u3.       ;    end: goto no block;
     al  w0  0         ;    reset:
     rs  w0  x1+s0     ;   state:=running;
     jl.     j0.       ;   goto prepare;

e.                     ; end of before header
; fpa-subproc          discette
; jr, 78.08.22

; after header and data transmitted
;
; entered by mainproc, when a header and a corresponding datablock
; (if any) has been transmitted.
; the result of the transmission is checked and if an error has
; occured, the message is returned with result=4 (receiver
; malfunction).
;
; finally the state of the subproc is checked for transmission of a
; new block.

b. i10,j10 w.

q2:  jl. w3  u40.      ; after header: test header transmitted
     jl.     u2.       ; error: goto testmore
     jl.     u2.       ;  goto testmore

e.                     ; end of header and data transmitted
; fpa-subproc          discette
; jr, 78.08.22

; after header received
;
; a header has been received.
; for this kind of subprocs (with no special actions) it can
; only specify the functions <answer input with data> or
; <answer message with data>.
;
; upon entry: w1=subproc

b. i10,j10 w.

q3:  jl. w3  u50.      ; after header received: test answer header
     jl.     u2.       ;  goto testmore

e.                     ; end of after header received
; fpa-subproc          discette
; jr, 78.08.22

; after data received
;
; check transmission.
;
; upon entry: w1=subproc

b. i10,j10 w.

q4:  jl. w3  u60.      ; after data received: test data received
     jl.     u2.       ;  goto testmore

; attention. no special action

     jl.     u2.       ;  goto testmore

e.                     ; end of data received
; fpa-subproc          discette
; jr, 78.08.22

; after create
;
; the subproc has just been created.
; no special action
;
; upon entry: w1=subproc

b. i10,j10 w.

q5:                    ; after create:
     jl      (b101)    ;  goto return

e.                     ; end of after create

; special procedures used in the discette driver.

; procedure deliver stopped answer.
; the message buffer defined in b18 is returned to the sender with 
; status = stopped and bytes, chars transferred = 0, 0.
;        call:         return:
; w0                   destroyed
; w1                   proc
; w2                   destroyed
; w3     link          destroyed

b.w.

n0:  al  w0  1<8       ; deliver stopped answer:
     rs  w0  g20       ;   status(answer):=stopped;
     al  w0  0         ;   bytes trf(answer):=0;
     rs  w0  g21       ;   chars trf(answer):=0;
     rs  w0  g22       ;   deliver answer;
     jl      g18       ; exit: return to link;
e.

; procedure check queue.
; if the message entry table is empty (=> no operations under execution
; in the net) the message buffers in the event queue are returned with
; answer stopped until either the queue is empty or a reset operation is
; met.
; the procedure returnes to link+2 when the queue is emptied and a reset
; operation is found, else to link.
; by return the state is
;        0   event queue emptied and reset found
;        2   message entry table not empty
;        4   event queue emptied
;        call:         return:
; w0                   destroyed
; w1     proc          unchanged
; w2                   destroyed
; w3     link          destoyed

b.j4 w.
n1:  al  w0  0         ; check queue:
     al  w2  x1+p19    ;
j0:  se  w0 (x2)       ;   for entry:=first in entry table to last do
     jl.     j1.       ;   if entry used then
     al  w2  x2+2      ;       goto not empty;
     se  w2  x1+p19+v0*2;
     jl.     j0.       ;
     am      4-2       ; empty: state:=stopped;
j1:  al  w2  2         ; not empty: state:=waiting for stop;
     rs  w2  x1+s0     ;
     am      x2-2      ;
     jl      x3        ; exit: return to link+state-2;
e.

; procedure clean mess queue.

b.i6,j6 w.
n2:  rs. w3  i0.       ; clean mess queue:
j0:  jl. w3  u12.      ;   for mess:=first in mess queue until last do
     sn  w2  0         ;     if operation(mess)=reset then
     jl.    (i0.)      ;       return to link+2;
     bz  w0  x2+8      ;
     sn  w0  2         ;
     jl.     j1.       ;
     jl. w3  n0.       ;
     jl.     j0.       ;
j1:  am.    (i0.)      ;
     jl      +2        ;
i0:   0                ;
e.


e.                     ; end of discette driver.

z.                     ;

h122=h100



; end of subprocess-code
;***********************

e.

; end of fpa-driver code
;***********************

e.

z.
h33=g3, h34=g3, h35=g3
h90=g3

